.travis.yml

@@ -46,7 +46,6 @@ script:
 - raco test -l tests/zo-path
 - raco test -l tests/xml/test
 - raco test -l tests/db/all-tests
-- raco test -c tests/stxparse
 notifications:
   irc: chat.freenode.net#racket-dev
   email:
@@ -57,5 +56,3 @@ notifications:
     on_success: change
   slack:
     secure: A19kphrabQHO8TU6qZcBaLQxdSNpm1ypEtbQsh8Ucg6HYPP7y1q7O7JZEndoMRHE9CNKZ9oXQzqR8H1IFVTlnjFFIJfkZzZ1YSNk4abSomhpWCq9daKMfwlcuTtY6PeI1nDVpka4/hiJGn9qzmaKYXle9Sl4CX2VEYp8o8PgMEs=
-    rooms:
-      secure: FsKzp4ItmOqd/YxqgsElgfjGW2/TU03p2p3ss+PQl/pKDQNnR/2b4pWCQ7GuqYibkmtiH1jYwrnuaLN4Cc+JyN7Z+zUtO4VSORsh3zt/gTsfgphMpCP6cB4sTqUh6AWsZOgzikj+fh7ORHEXVswQwlRHErTgZVEdEkWHBh4UWzc=

INSTALL.txt

@@ -53,7 +53,7 @@ If you stick with this repository, then you have several options:
 Quick Instructions: In-place Build
 ==================================
 
-On Unix (including Linux) and Mac OS, `make' (or `make in-place')
+On Unix (including Linux) and Mac OS X, `make' (or `make in-place')
 creates a build in the "racket" directory.
 
 On Windows with Microsoft Visual Studio (any version between 2008/9.0
@@ -81,9 +81,9 @@ installs into "<dir>" (which must be an absolute path) with binaries
 in "<dir>/bin", packages in "<dir>/share/racket/pkgs", documentation
 in "<dir>/share/racket/doc", etc.
 
-On Mac OS, `make unix-style PREFIX=<dir>' builds and installs into
+On Mac OS X, `make unix-style PREFIX=<dir>' builds and installs into
-"<dir>" (which must be an absolute path) with binaries in "<dir>/bin",
+"<dir>" (whichmust be an absolute path) with binaries in "<dir>/bin",
-packages in "<dir>/share/pkgs", documentation in "<dir>/doc", etc.
+packges in "<dir>/share/pkgs", documentation in "<dir>/doc", etc.
 
 On Windows, Unix-style install is not supported.
 
@@ -196,7 +196,7 @@ libraries. See the documentation for `raco setup' for information on
 the options.
 
 For cross compilation, add configuration options to
-`CONFIGURE_ARGS_qq="..."' as described in the "README" of "racket/src",
+`CONFIGURE_ARGS_qq="..."' as descibed in the "README" of "racket/src",
 but also add a `PLAIN_RACKET=...' argument for the top-level makefile
 to specify the same executable as in an `--enable-racket=...' for
 `configure'.
@@ -212,7 +212,7 @@ If you want to install packages manually out of the "pkgs" directory,
 the `local-catalog' target creates a catalog as "racket/local/catalog"
 that merges the currently configured catalog's content with pointers
 to the packages in "pkgs". A Unix-style build works that way: it
-builds and installs minimal Racket, and then it installs packages out
+builds and installs minimal Racket, and then it installs packags out
 of a catalog that is created by `make local-catalog'.
 
 To add a package catalog that is used after the content of "pkgs" but
@@ -321,7 +321,7 @@ normalizing the Windows results to "i386-win32" and "x86_63-win32",
 -<dist-suffix> is omitted unless a `#:dist-suffix' string is specified
 for the client in the site configuration, and <ext> is
 platform-specific: ".sh" for Unix (including Linux), ".dmg" or ".pkg"
-for Mac OS, and ".exe" for Windows.
+for Mac OS X, and ".exe" for Windows.
 
 Generating Installer Web Sites
 ------------------------------
@@ -517,7 +517,7 @@ In more detail:
      To create a ".tgz" archive instead of an installer (or any
      platform), set `TGZ_MODE' to "--tgz".
 
-     For a Mac OS installer, set `SIGN_IDENTITY' as the name to
+     For a Mac OS X installer, set `SIGN_IDENTITY' as the name to
      which the signing certificate is associated. Set `MAC_PKG_MODE'
      to "--mac-pkg" to create a ".pkg" installer instead of a ".dmg"
      image.

Makefile

@@ -98,7 +98,7 @@ win32-as-is:
 	$(WIN32_RUN_RACO) setup $(ALL_PLT_SETUP_OPTIONS)
 
 # ------------------------------------------------------------
-# Unix-style build (Unix and Mac OS, only)
+# Unix-style build (Unix and Mac OS X, only)
 
 PREFIX = 
 
@@ -234,7 +234,7 @@ SOURCE_MODE =
 # name or installation path:
 VERSIONLESS_MODE =
 
-# Set to "--mac-pkg" to create ".pkg"-based installers for Mac OS,
+# Set to "--mac-pkg" to create ".pkg"-based installers for Mac OS X,
 # instead of a ".dmg" for drag-and-drop installation:
 MAC_PKG_MODE =
 
@@ -271,7 +271,7 @@ BUILD_STAMP =
 # the default as the version number:
 INSTALL_NAME =
 
-# For Mac OS, a signing identity (spaces allowed) for binaries in an
+# For Mac OS X, a signing identity (spaces allowed) for binaries in an
 # installer:
 SIGN_IDENTITY = 
 

README.md

@@ -1,34 +0,0 @@
-[![Linux/Mac Build
-Status](https://travis-ci.org/racket/racket.svg?branch=master)](https://travis-ci.org/racket/racket)
-[![Windows build status](https://ci.appveyor.com/api/projects/status/hqir4eib0okk6xar?svg=true)](https://ci.appveyor.com/project/plt/racket)
-
-
-This is the source code for the core of Racket.  See
-"INSTALL.txt" for full information on building Racket.
-
-To build the full Racket distribution from this repository, run `make`
-in the top-level directory. To build the Minimal Racket, run `make
-base`.
-
-The rest of the Racket distribution source code is in other
-repositories under [the Racket GitHub
-organization](https://github.com/racket).
-
-Contribute to Racket by submitting a pull request, joining the
-[development mailing list](https://lists.racket-lang.org), or visiting
-the IRC channel.
-
-License
--------
-
-Racket
-Copyright (c) 2010-2017 PLT Design Inc.
-
-Racket is distributed under the GNU Lesser General Public License
-(LGPL).  This implies that you may link Racket into proprietary
-applications, provided you follow the rules stated in the LGPL.  You can
-also modify Racket; if you distribute a modified version, you must
-distribute it under the terms of the LGPL, which in particular states
-that you must release the source code for the modified software.  
-
-See racket/src/COPYING_LESSER.txt for more information.

README.txt

@@ -0,0 +1,17 @@
+This is the source code for the main Racket distribution.  See
+"INSTALL.txt" for information on building Racket.
+
+License
+-------
+
+Racket
+Copyright (c) 2010-2016 PLT Design Inc.
+
+Racket is distributed under the GNU Lesser General Public License
+(LGPL).  This implies that you may link Racket into proprietary
+applications, provided you follow the rules stated in the LGPL.  You can
+also modify Racket; if you distribute a modified version, you must
+distribute it under the terms of the LGPL, which in particular states
+that you must release the source code for the modified software.  
+
+See racket/src/COPYING_LESSER.txt for more information.

appveyor.yml

@@ -27,7 +27,7 @@ test_script:
 - racket\raco.exe test -l tests/match/main
 - racket\raco.exe test -l tests/zo-path
 - racket\raco.exe test -l tests/xml/test
-- racket\raco.exe test -c tests/stxparse
+
 
 notifications:
  - provider: Email
@@ -38,5 +38,5 @@ notifications:
 
  - provider: Slack
    auth_token:
-     secure: VsZxuLzL7f/k5c/UEkiJKYxvNh9ss0Gq5ifwoZl4rlwzgtkU+2bOEo9zaP2FREF5Tb/iw4r7yQXdAYHPeo8GBQ2GQn2IksABPBEUkFrxj1k=
+     secure: WCMkqS/3iB39INmhzQoZDNJ3zcOXLaRueWvaayOD9MW15DcWrGOAxz7dGrhh/EcQ
    channel: notifications

pkgs/at-exp-lib/LICENSE.txt

@@ -1,5 +1,5 @@
 at-exp-lib
-Copyright (c) 2010-2017 PLT Design Inc.
+Copyright (c) 2010-2016 PLT Design Inc.
 
 This package is distributed under the GNU Lesser General Public
 License (LGPL).  This means that you can link this package into proprietary

pkgs/at-exp-lib/at-exp/lang/reader.rkt

@@ -16,7 +16,15 @@
     (make-meta-reader
      'at-exp
      "language path"
-     lang-reader-module-paths
+     (lambda (bstr)
+       (let* ([str (bytes->string/latin-1 bstr)]
+              [sym (string->symbol str)])
+         (and (module-path? sym)
+              (vector
+               ;; try submod first:
+               `(submod ,sym reader)
+               ;; fall back to /lang/reader:
+               (string->symbol (string-append str "/lang/reader"))))))
      wrap-reader
      (lambda (orig-read-syntax)
        (define read-syntax (wrap-reader orig-read-syntax))

pkgs/base/LICENSE.txt

@@ -1,5 +1,5 @@
 base
-Copyright (c) 2010-2017 PLT Design Inc.
+Copyright (c) 2010-2016 PLT Design Inc.
 
 This package is distributed under the GNU Lesser General Public
 License (LGPL).  This means that you can link this package into proprietary

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.8.0.2")
+(define version "6.4.0.15")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/compiler-lib/LICENSE.txt

@@ -1,11 +0,0 @@
-compiler-lib
-Copyright (c) 2010-2017 PLT Design Inc.
-
-This package is distributed under the GNU Lesser General Public
-License (LGPL).  This means that you can link this package into proprietary
-applications, provided you follow the rules stated in the LGPL.  You
-can also modify this package; if you distribute a modified version,
-you must distribute it under the terms of the LGPL, which in
-particular means that you must release the source code for the
-modified software.  See http://www.gnu.org/copyleft/lesser.html
-for more information.

pkgs/compiler-lib/compiler/bundle-dist.rkt

@@ -1,94 +0,0 @@
-
-(module bundle-dist racket/base
-  (require racket/file
-           (only-in racket/base lambda)
-           racket/path
-	   racket/system
-	   file/zip
-	   file/tar)
-
-  (provide bundle-put-file-extension+style+filters
-	   bundle-directory)
-  
-  (define (bundle-file-suffix)
-    (case (system-type)
-      [(macosx) "dmg"]
-      [(windows) "zip"]
-      [(unix) "tgz"]))
-
-  (define (bundle-put-file-extension+style+filters)
-    (values (bundle-file-suffix)
-	    null
-	    (case (system-type)
-	      [(windows) '(("Zip file" "*.zip"))]
-	      [(macosx) '(("Disk image" "*.dmg"))]
-	      [(unix) '(("Gzipped tar file" "*.tgz"))])))
-
-  (define (add-suffix name suffix)
-    (if (filename-extension name)
-	name
-	(path-replace-suffix name
-			     (string->bytes/utf-8 (string-append "." suffix)))))
-
-  (define (with-prepared-directory dir for-exe? k)
-    ;; If `dir' contains multiple files, create a new
-    ;;  directory that contains a copy of `dir'
-    (if (and for-exe?
-	     (= 1 (length (directory-list dir))))
-	(k dir)
-	(let ([temp-dir (make-temporary-file "bundle-tmp-~a" 'directory)])
-	  (dynamic-wind
-	      void
-	      (lambda ()
-		(let ([dest
-		       (let-values ([(base name dir?) (split-path dir)])
-			 (build-path temp-dir name))])
-		  (make-directory dest)
-		  (let loop ([src dir][dest dest])
-		    (for-each (lambda (f)
-				(let ([src (build-path src f)]
-				      [dest (build-path dest f)])
-				  (cond
-				   [(directory-exists? src)
-				    (make-directory dest)
-				    (loop src dest)]
-				   [(file-exists? src)
-				    (copy-file src dest)
-				    (file-or-directory-modify-seconds 
-				     dest
-				     (file-or-directory-modify-seconds src))])))
-			      (directory-list src))))
-		(k temp-dir))
-	      (lambda () (delete-directory/files temp-dir))))))
-
-  (define bundle-directory
-    (lambda (target dir [for-exe? #f])
-      (let ([target (add-suffix target (bundle-file-suffix))])
-	(case (system-type)
-	  [(macosx)
-	   (with-prepared-directory
-	    dir for-exe?
-	    (lambda (dir)
-	      (let* ([cout (open-output-bytes)]
-		     [cerr (open-output-bytes)]
-		     [cin (open-input-bytes #"")]
-		     [p (process*/ports
-			 cout cin cerr
-			 "/usr/bin/hdiutil"
-			 "create" "-format" "UDZO"
-			 "-imagekey" "zlib-level=9"
-			 "-mode" "555" 
-			 "-volname" (path->string
-				     (path-replace-suffix (file-name-from-path target) #""))
-			 "-srcfolder" (path->string (cleanse-path (path->complete-path dir)))
-			 (path->string (cleanse-path (path->complete-path target))))])
-		((list-ref p 4) 'wait)
-		(unless (eq? ((list-ref p 4) 'status) 'done-ok)
-		  (error 'bundle-directory
-			 "error bundling: ~a"
-			 (regexp-replace #rx"[\r\n]*$" (get-output-string cerr) ""))))))]
-	  [(windows unix)
-	   (let-values ([(base name dir?) (split-path (path->complete-path dir))])
-	     (parameterize ([current-directory base])
-	       ((if (eq? 'unix (system-type)) tar-gzip zip) target name)))]
-	  [else (error 'bundle-directory "don't know how")])))))

pkgs/compiler-lib/compiler/commands/decompile.rkt

@@ -1,91 +0,0 @@
-#lang racket/base
-(require racket/cmdline
-         raco/command-name
-         compiler/zo-parse
-         compiler/decompile
-         compiler/compilation-path
-         racket/pretty
-         racket/format)
-
-(define (get-name)
-  (string->symbol (short-program+command-name)))
-
-(define force? #f)
-
-(define source-files
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("--force") "Ignore timestamp mimatch on associated \".zo\""
-    (set! force? #t)]
-   [("--columns" "-n") n "Format for <n> columns"
-    (let ([num (string->number n)])
-      (unless (exact-positive-integer? num)
-        (raise-user-error (get-name)
-                          "not a valid column count: ~a" n))
-      (pretty-print-columns num))]
-   #:args source-or-bytecode-file
-   source-or-bytecode-file))
-
-(define (check-files orig-file alt-file)
-  (cond
-   [(not (file-exists? alt-file))
-    (cond
-     [(file-exists? orig-file)
-      (unless (is-bytecode-file? orig-file)
-        (raise-user-error (get-name)
-                          (~a "not a bytecode file, and no associated \".zo\" file;\n"
-                              " consider using `raco make` to compile the source file to bytecode\n"
-                              "  path: ~a\n"
-                              "  tried associated path: ~a")
-                          orig-file
-                          alt-file))]
-     [else
-      (raise-user-error (get-name)
-                        (~a "no such file, and no associated \".zo\" file\n"
-                            "  path: ~a\n"
-                            "  tried associated path: ~a")
-                        orig-file
-                        alt-file)])]
-   [(not (is-bytecode-file? alt-file))
-    (raise-user-error (get-name)
-                      (~a "associated \".zo\" file is not a bytecode file\n"
-                          "  original path: ~a\n"
-                          "  associated path: ~a")
-                      orig-file
-                      alt-file)]
-   [(and (not force?)
-         ((file-or-directory-modify-seconds orig-file
-                                            #f
-                                            (lambda () -inf.0))
-          . > .
-          (file-or-directory-modify-seconds alt-file)))
-    ;; return a warning:
-    (raise-user-error (get-name)
-                      (~a "associated \".zo\" file's date is older than given file's date;\n"
-                          " consider using `raco make` to rebuild the source file, or use `--force`\n"
-                          " to skip the date check\n"
-                          "  original path: ~a\n"
-                          "  associated path: ~a")
-                      orig-file
-                      alt-file)]))
-
-(define (is-bytecode-file? orig-file)
-  (call-with-input-file*
-   orig-file
-   (lambda (i)
-     (equal? #"#~" (read-bytes 2 i)))))
-
-(for ([zo-file source-files])
-  (let ([zo-file (path->complete-path zo-file)])
-    (let-values ([(base name dir?) (split-path zo-file)])
-      (let ([alt-file (get-compilation-bytecode-file zo-file)])
-        (check-files zo-file alt-file)
-        (parameterize ([current-load-relative-directory base]
-                       [print-graph #t])
-          (pretty-write
-           (decompile
-            (call-with-input-file*
-             (if (file-exists? alt-file) alt-file zo-file)
-             (lambda (in)
-               (zo-parse in))))))))))

pkgs/compiler-lib/compiler/commands/exe-dir.rkt

@@ -1,33 +0,0 @@
-#lang scheme/base
-(require scheme/cmdline
-         raco/command-name
-         compiler/distribute)
-
-(define verbose (make-parameter #f))
-(define exe-embedded-collects-path (make-parameter #f))
-(define exe-dir-add-collects-dirs (make-parameter null))
-
-(define-values (dest-dir source-files)
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("--collects-path") path "Set <path> as main collects for executables"
-    (exe-embedded-collects-path path)]
-   #:multi
-   [("++collects-copy") dir "Add collects in <dir> to directory"
-    (exe-dir-add-collects-dirs (append (exe-dir-add-collects-dirs) (list dir)))]
-   #:once-each
-   [("-v") "Verbose mode"
-    (verbose #t)]
-   #:args (dest-dir . executable)
-   (values dest-dir executable)))
-
-(assemble-distribution
- dest-dir
- source-files
- #:collects-path (exe-embedded-collects-path)
- #:copy-collects (exe-dir-add-collects-dirs))
-(when (verbose)
-  (printf " [output to \"~a\"]\n" dest-dir))
-
-(module test racket/base)

pkgs/compiler-lib/compiler/commands/exe.rkt

@@ -1,155 +0,0 @@
-#lang racket/base
-(require racket/cmdline
-         raco/command-name
-         compiler/private/embed
-         launcher/launcher
-         dynext/file
-         setup/dirs)
-
-(define verbose (make-parameter #f))
-(define very-verbose (make-parameter #f))
-
-(define gui (make-parameter #f))
-(define 3m (make-parameter #t))
-(define launcher (make-parameter #f))
-
-(define exe-output (make-parameter #f))
-(define exe-embedded-flags (make-parameter '("-U" "--")))
-(define exe-embedded-libraries (make-parameter null))
-(define exe-aux (make-parameter null))
-(define exe-embedded-config-path (make-parameter "etc"))
-(define exe-embedded-collects-path (make-parameter null))
-(define exe-embedded-collects-dest (make-parameter #f))
-
-(define source-file
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("-o") file "Write executable as <file>"
-    (exe-output file)]
-   [("--gui") "Generate GUI executable"
-    (gui #t)]
-   [("-l" "--launcher") "Generate a launcher"
-    (when (or (find-addon-tethered-gui-bin-dir)
-              (find-addon-tethered-console-bin-dir))
-      ;; When an addon-executable directory is configured, treat the
-      ;; addon directory more like an installation directory, instead
-      ;; of a user-specific directory: record it, and remove the -U
-      ;; flag (if any)
-      (exe-embedded-flags
-       (append
-        (list "-A" (path->string (find-system-path 'addon-dir)))
-        (remove "-U" (exe-embedded-flags)))))
-    (launcher #t)]
-   [("--config-path") path "Set <path> as configuration directory for executable"
-    (exe-embedded-config-path path)]
-   [("--collects-path") path "Set <path> as main collects for executable"
-    (exe-embedded-collects-path path)]
-   [("--collects-dest") dir "Write collection code to <dir>"
-    (exe-embedded-collects-dest dir)]
-   [("--ico") .ico-file "Set Windows icon for executable"
-    (exe-aux (cons (cons 'ico .ico-file) (exe-aux)))]
-   [("--icns") .icns-file "Set Mac OS icon for executable"
-    (exe-aux (cons (cons 'icns .icns-file) (exe-aux)))]
-   [("--orig-exe") "Use original executable instead of stub"
-    (exe-aux (cons (cons 'original-exe? #t) (exe-aux)))]
-   [("--3m") "Generate using 3m variant"
-    (3m #t)]
-   [("--cgc") "Generate using CGC variant"
-    (3m #f)]
-   #:multi
-   [("++aux") aux-file "Extra executable info (based on <aux-file> suffix)"
-    (let ([auxes (extract-aux-from-path (path->complete-path aux-file))])
-      (when (null? auxes)
-        (printf " warning: no recognized information from ~s\n" aux-file))
-      (exe-aux (append auxes (exe-aux))))]
-   [("++lib") lib "Embed <lib> in executable"
-    (exe-embedded-libraries (append (exe-embedded-libraries) (list lib)))]
-   [("++exf") flag "Add flag to embed in executable"
-    (exe-embedded-flags (append (exe-embedded-flags) (list flag)))]
-   [("--exf") flag "Remove flag to embed in executable"
-    (exe-embedded-flags (remove flag (exe-embedded-flags)))]
-   [("--exf-clear") "Clear flags to embed in executable"
-    (exe-embedded-flags null)]
-   [("--exf-show") "Show flags to embed in executable"
-    (printf "Flags to embed: ~s\n" (exe-embedded-flags))]
-   #:once-each
-   [("-v") "Verbose mode"
-    (verbose #t)]
-   [("--vv") "Very verbose mode"
-    (verbose #t)
-    (very-verbose #t)]
-   #:args (source-file)
-   source-file))
-
-(let ([dest (mzc:embedding-executable-add-suffix
-             (or (exe-output)
-                 (extract-base-filename/ss source-file
-                                           (string->symbol (short-program+command-name))))
-             (gui))])
-  (unless (file-exists? source-file)
-    (raise-user-error (string->symbol (short-program+command-name))
-                      "source file does not exist\n  path: ~a" source-file))
-  (with-handlers ([exn:fail:filesystem? (lambda (exn) (void))])
-    (call-with-input-file* dest
-      (lambda (dest-in)
-        (call-with-input-file* source-file
-          (lambda (source-in)
-            (when (equal? (port-file-identity dest-in)
-                          (port-file-identity source-in))
-              (raise-user-error (string->symbol (short-program+command-name))
-                                (string-append
-                                 "source file is the same as the destination file"
-                                 "\n  source path: ~a"
-                                 "\n  destination path: ~a")
-                                source-file
-                                dest)))))))
-  (cond
-   [(launcher)
-    (parameterize ([current-launcher-variant (if (3m) '3m 'cgc)])
-      ((if (gui) 
-           make-gracket-launcher 
-           make-racket-launcher)
-       (append (list "-t" (path->string (path->complete-path source-file)))
-               (exe-embedded-flags))
-       dest
-       (exe-aux)))]
-   [else
-    (define mod-sym (string->symbol
-                     (format "#%mzc:~a"
-                             (let-values ([(base name dir?)
-                                           (split-path source-file)])
-                               (path->bytes (path-replace-suffix name #""))))))
-    (mzc:create-embedding-executable
-     dest
-     #:mred? (gui)
-     #:variant (if (3m) '3m 'cgc)
-     #:verbose? (very-verbose)
-     #:modules (cons `(#%mzc: (file ,source-file) (main configure-runtime))
-                     (map (lambda (l) `(#t (lib ,l)))
-                          (exe-embedded-libraries)))
-     #:configure-via-first-module? #t
-     #:early-literal-expressions
-     (parameterize ([current-namespace (make-base-namespace)])
-       (define cr-sym (string->symbol (format "~a(configure-runtime)" mod-sym)))
-       (list
-        (compile
-         `(when (module-declared? '',cr-sym)
-            (dynamic-require '',cr-sym #f)))))
-     #:literal-expression
-     (parameterize ([current-namespace (make-base-namespace)])
-       (define main-sym (string->symbol (format "~a(main)" mod-sym)))
-       (compile
-        `(begin
-           (namespace-require '',mod-sym)
-           (when (module-declared? '',main-sym)
-             (dynamic-require '',main-sym #f)))))
-     #:cmdline (exe-embedded-flags)
-     #:collects-path (exe-embedded-collects-path)
-     #:collects-dest (exe-embedded-collects-dest)
-     #:aux (cons `(config-dir . ,(exe-embedded-config-path))
-                 (exe-aux)))])
-  (when (verbose)
-    (printf " [output to \"~a\"]\n" dest)))
-
-(module test racket/base)

pkgs/compiler-lib/compiler/commands/expand.rkt

@@ -1,42 +0,0 @@
-#lang racket/base
-
-(module expand racket/base
-  (require racket/cmdline
-           raco/command-name
-           racket/pretty)
-  
-  (provide show-program)
-  
-  (define (show-program expand)
-    (define source-files
-      (command-line
-       #:program (short-program+command-name)
-       #:once-each
-       [("--columns" "-n") n "Format for <n> columns"
-        (let ([num (string->number n)])
-          (unless (exact-positive-integer? num)
-            (raise-user-error (string->symbol (short-program+command-name))
-                              "not a valid column count: ~a" n))
-          (pretty-print-columns num))]
-       #:args source-file
-       source-file))
-
-    (for ([src-file source-files])
-      (let ([src-file (path->complete-path src-file)])
-        (let-values ([(base name dir?) (split-path src-file)])
-          (parameterize ([current-load-relative-directory base]
-                         [current-namespace (make-base-namespace)]
-                         [read-accept-reader #t])
-            (call-with-input-file*
-             src-file
-             (lambda (in)
-               (port-count-lines! in)
-               (let loop ()
-                 (let ([e (read-syntax src-file in)])
-                   (unless (eof-object? e)
-                     (pretty-write (syntax->datum (expand e)))
-                     (loop))))))))))))
-
-(require (submod "." expand))
-(show-program expand)
-  

pkgs/compiler-lib/compiler/commands/info.rkt

@@ -1,15 +0,0 @@
-#lang info
-
-(define raco-commands
-  '(("make" compiler/commands/make "compile source to bytecode" 100)
-    ("exe" compiler/commands/exe "create executable" 20)
-    ("pack" compiler/commands/pack "pack files/collections into a .plt archive" #f)
-    ("unpack" compiler/commands/unpack "unpack files/collections from a .plt archive" #f)
-    ("decompile" compiler/commands/decompile "decompile bytecode" #f)
-    ("test" compiler/commands/test "run tests associated with files/directories" 15)
-    ("expand" compiler/commands/expand "macro-expand source" #f)
-    ("read" compiler/commands/read "read and pretty-print source" #f)
-    ("distribute" compiler/commands/exe-dir "prepare executable(s) in a directory for distribution" #f)
-    ("demodularize" compiler/demodularizer/batch "produce a whole program from a single module" #f)))
-
-(define test-responsibles '(("test.rkt" jay)))

pkgs/compiler-lib/compiler/commands/make.rkt

@@ -1,119 +0,0 @@
-#lang racket/base
-(require racket/cmdline
-         raco/command-name
-         compiler/cm
-         compiler/compiler
-         compiler/compilation-path
-         dynext/file
-         setup/parallel-build
-         setup/path-to-relative
-         racket/match)
-
-(module test racket/base)
-
-(define verbose (make-parameter #f))
-(define very-verbose (make-parameter #f))
-(define disable-inlining (make-parameter #f))
-
-(define disable-deps (make-parameter #f))
-(define disable-const (make-parameter #f))
-(define prefixes (make-parameter null))
-(define assume-primitives (make-parameter #t))
-(define worker-count (make-parameter 1))
-
-(define mzc-symbol (string->symbol (short-program+command-name)))
-
-(define source-files
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("-j") n "Compile with up to <n> tasks in parallel" 
-    (let ([num (string->number n)])
-      (unless num (raise-user-error (format "~a: bad count for -j: ~s"
-                                            (short-program+command-name) 
-                                            n)))
-      (worker-count num))]
-   [("--disable-inline") "Disable procedure inlining during compilation"
-    (disable-inlining #t)]
-   [("--disable-constant") "Disable enforcement of module constants"
-    (disable-const #t)]
-   [("--no-deps") "Compile immediate files without updating dependencies"
-    (disable-deps #t)]
-   [("-p" "--prefix") file "Add elaboration-time prefix file for --no-deps"
-    (prefixes (append (prefixes) (list file)))]
-   [("--no-prim") "Do not assume `scheme' bindings at top level for --no-deps"
-    (assume-primitives #f)]
-   [("-v") "Verbose mode"
-    (verbose #t)]
-   [("--vv") "Very verbose mode"
-    (verbose #t)
-    (very-verbose #t)]
-   #:args (file . another-file) (cons file another-file)))
-
-(cond 
-  ;; Just compile one file:
-  [(disable-deps)
-    (let ([prefix
-           `(begin
-              (require scheme)
-              ,(if (assume-primitives)
-                   '(void)
-                   '(namespace-require/copy 'scheme))
-              ,@(map (lambda (s) `(load ,s)) (prefixes))
-              (void))])
-      ((compile-zos prefix #:verbose? (verbose))
-       source-files
-       'auto))]
-  ;; Normal make:
-  [(= (worker-count) 1)
-    (let ([n (make-base-empty-namespace)]
-          [did-one? #f])
-      (parameterize ([current-namespace n]
-                     [manager-trace-handler
-                      (if (very-verbose)
-                          (λ (p) (printf "  ~a\n" p))
-                          (manager-trace-handler))]
-                     [manager-compile-notify-handler
-                      (lambda (p)
-                        (set! did-one? #t)
-                        (when (verbose)
-                          (printf "  making ~s\n" p)))])
-        (for ([file source-files])
-          (unless (file-exists? file)
-            (error mzc-symbol "file does not exist: ~a" file))
-          (set! did-one? #f)
-          (let ([name (extract-base-filename/ss file mzc-symbol)])
-            (when (verbose)
-              (printf "\"~a\":\n" file))
-            (parameterize ([compile-context-preservation-enabled
-                            (disable-inlining)]
-                           [compile-enforce-module-constants
-                            (not (disable-const))])
-              (managed-compile-zo file))
-            (when (verbose)
-              (printf " [~a \"~a\"]\n"
-                      (if did-one? "output to" "already up-to-date at")
-                      (get-compilation-bytecode-file file)))))))]
-  ;; Parallel make:
-  [else
-   (define path-cache (make-hash))
-   (or (parallel-compile-files
-        source-files
-        #:worker-count (worker-count)
-        #:handler (lambda (id type work msg out err)
-                    (define (->rel p)
-                      (path->relative-string/library p #:cache path-cache))
-                    (match type
-                      ['start (when (verbose) (printf " ~a making ~a\n" id (->rel work)))]
-                      ['done (when (verbose) (printf " ~a made ~a\n" id (->rel work)))]
-                      ['output (printf " ~a output from: ~a\n~a~a" id work out err)]
-                      [else (printf " ~a error compiling ~a\n~a\n~a~a" id work msg out err)]))
-        #:options (let ([cons-if-true (lambda (bool carv cdrv)
-                                        (if bool
-                                            (cons carv cdrv)
-                                            cdrv))])
-                    (cons-if-true
-                     (very-verbose)
-                     'very-verbose
-                     (cons-if-true (disable-inlining) 'disable-inlining null))))
-       (exit 1))])

pkgs/compiler-lib/compiler/commands/pack.rkt

@@ -1,99 +0,0 @@
-#lang scheme/base
-(require scheme/cmdline
-         raco/command-name
-         setup/pack
-         setup/getinfo
-         compiler/distribute)
-
-(define verbose (make-parameter #f))
-
-(define collection? (make-parameter #f))
-
-(define default-plt-name "archive")
-
-(define plt-name (make-parameter default-plt-name))
-(define plt-files-replace (make-parameter #f))
-(define plt-files-plt-relative? (make-parameter #f))
-(define plt-files-plt-home-relative? (make-parameter #f))
-(define plt-force-install-dir? (make-parameter #f))
-(define plt-setup-collections (make-parameter null))
-(define plt-include-compiled (make-parameter #f))
-
-(define mzc-symbol (string->symbol (short-program+command-name)))
-
-(define-values (plt-output source-files)
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("--collect") "<path>s specify collections instead of files/dirs"
-    (collection? #t)]
-   [("--plt-name") name "Set the printed <name> describing the archive"
-    (plt-name name)]
-   [("--replace") "Files in archive replace existing files when unpacked"
-    (plt-files-replace #t)]
-   [("--at-plt") "Files/dirs in archive are relative to user's add-ons directory"
-    (plt-files-plt-relative? #t)]
-   #:once-any
-   [("--all-users") "Files/dirs in archive go to PLT installation if writable"
-    (plt-files-plt-home-relative? #t)]
-   [("--force-all-users") "Files/dirs forced to PLT installation"
-    (plt-files-plt-home-relative? #t) (plt-force-install-dir? #t)]
-   #:once-each
-   [("--include-compiled") "Include \"compiled\" subdirectories in the archive"
-    (plt-include-compiled #t)]
-   #:multi
-   [("++setup") collect "Setup <collect> after the archive is unpacked"
-    (plt-setup-collections (append (plt-setup-collections) (list collect)))]
-   #:once-each
-   [("-v") "Verbose mode"
-    (verbose #t)]
-   #:args (dest-file . path)
-   (values dest-file path)))
-
-(if (not (collection?))
-    ;; Files and directories
-    (begin
-      (for ([fd source-files])
-        (unless (relative-path? fd)
-          (error mzc-symbol
-                 "file/directory is not relative to the current directory: \"~a\""
-                 fd)))
-      (pack-plt plt-output
-                (plt-name)
-                source-files
-                #:collections (map list (plt-setup-collections))
-                #:file-mode (if (plt-files-replace) 'file-replace 'file)
-                #:plt-relative? (or (plt-files-plt-relative?)
-                                    (plt-files-plt-home-relative?))
-                #:at-plt-home? (plt-files-plt-home-relative?)
-                #:test-plt-dirs (if (or (plt-force-install-dir?)
-                                        (not (plt-files-plt-home-relative?)))
-                                    #f
-                                    '("collects" "doc" "include" "lib"))
-                #:requires
-                null)
-      (when (verbose)
-        (printf " [output to \"~a\"]\n" plt-output)))
-    ;; Collection
-    (begin
-      (pack-collections-plt
-       plt-output
-       (if (eq? default-plt-name (plt-name)) #f (plt-name))
-       (map (lambda (sf)
-              (let loop ([sf sf])
-                (let ([m (regexp-match "^([^/]*)/(.*)$" sf)])
-                  (if m (cons (cadr m) (loop (caddr m))) (list sf)))))
-            source-files)
-       #:replace? (plt-files-replace)
-       #:extra-setup-collections (map list (plt-setup-collections))
-       #:file-filter (if (plt-include-compiled)
-                         (lambda (path)
-                           (or (regexp-match #rx#"compiled$" (path->bytes path))
-                               (std-filter path)))
-                         std-filter)
-       #:at-plt-home? (plt-files-plt-home-relative?)
-       #:test-plt-collects? (not (plt-force-install-dir?)))
-      (when (verbose)
-        (printf " [output to \"~a\"]\n" plt-output))))
-
-(module test racket/base)

pkgs/compiler-lib/compiler/commands/read.rkt

@@ -1,4 +0,0 @@
-#lang racket/base
-(require (submod "expand.rkt" expand))
-
-(show-program (lambda (e) e))

pkgs/compiler-lib/compiler/commands/unpack.rkt

@@ -1,102 +0,0 @@
-#lang scheme/base
-(require scheme/cmdline
-         raco/command-name
-         setup/unpack
-         racket/file
-         racket/port
-         racket/match
-         racket/string
-         racket/pretty)
-
-(define verbose (make-parameter #f))
-
-(define just-show? (make-parameter #f))
-(define replace? (make-parameter #f))
-(define show-config? (make-parameter #f))
-
-(define mzc-symbol (string->symbol (short-program+command-name)))
-
-(define files
-  (command-line
-   #:program (short-program+command-name)
-   #:once-each
-   [("-l" "--list") "just list archive content"
-    (just-show? #t)]
-   [("-c" "--config") "show archive configuration"
-    (show-config? #t)]
-   [("-f" "--force") "replace existing files when unpacking"
-    (replace? #t)]
-   #:args archive
-   archive))
-
-(define (desc->path dir)
-  (if (path? dir)
-      dir
-      (apply build-path
-             (symbol->string (car dir))
-             (cdr dir))))
-
-(for ([filename (in-list files)])
-  (fold-plt-archive filename 
-                    (lambda (config a)
-                      (when (show-config?)
-                        (match config
-                          [`(lambda (request failure) 
-                              (case request 
-                                ((name) ,name) 
-                                ((unpacker) (quote mzscheme)) 
-                                ((requires) (quote ,reqs)) 
-                                ((conflicts) (quote ,conflicts)) 
-                                ((plt-relative?) ,plt-rel?) 
-                                ((plt-home-relative?) ,plt-home-rel?) 
-                                ((test-plt-dirs) ,test-plt-dirs) 
-                                (else (failure))))
-                           (printf "config:\n")
-                           (printf " name: ~s\n" name)
-                           (printf " requires:\n")
-                           (for ([c (in-list reqs)])
-                             (printf "  ~s ~s\n" (string-join (car c) "/") (cadr c)))
-                           (printf " conflicts:\n")
-                           (for ([c (in-list conflicts)])
-                             (printf "  ~s\n" (string-join c "/")))
-                           (cond
-                            [plt-home-rel? (printf " unpack to main installation\n")]
-                            [plt-rel? (printf " unpack to user add-ons\n")]
-                            [else (printf " unpack locally\n")])]
-                          [else
-                           (printf "config function:\n")
-                           (pretty-write config)]))
-                      a)
-                    (lambda (setup i a)
-                      (when (show-config?)
-                        (match setup
-                          [`(unit (import main-collects-parent-dir mzuntar) (export) (mzuntar void) (quote ,c))
-                           (printf "setup collections:\n")
-                           (for ([c (in-list c)])
-                             (printf " ~s\n" (string-join c "/")))]
-                          [else
-                           (printf "setup unit:\n")
-                           (pretty-write setup)]))
-                      a)
-                    (lambda (dir a)
-                      (unless (eq? dir 'same)
-                        (if (just-show?)
-                            (printf "~a\n" (path->directory-path (desc->path dir)))
-                            (make-directory* (desc->path dir))))
-                      a)
-                    (lambda (file i kind a)
-                      (if (just-show?)
-                          (printf "~a~a\n" (desc->path file)
-                                  (if (eq? kind 'file-replace)
-                                      " [replace]"
-                                      ""))
-                          (call-with-output-file*
-                           (desc->path file)
-                           #:exists (if (or (eq? kind 'file-replace)
-                                            (replace?))
-                                        'truncate/replace
-                                        'error)
-                           (lambda (o)
-                             (copy-port i o))))
-                      a)
-                    (void)))

pkgs/compiler-lib/compiler/compiler-unit.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-
-(require compiler/compiler compiler/sig racket/unit)
-(provide compiler@)
-(define-unit-from-context compiler@ compiler^)

pkgs/compiler-lib/compiler/decompile.rkt

@@ -1,606 +0,0 @@
-#lang racket/base
-(require compiler/zo-parse
-         syntax/modcollapse
-         racket/port
-         racket/match
-         racket/list
-         racket/set
-         racket/path)
-
-(provide decompile)
-
-;; ----------------------------------------
-
-(define primitive-table
-  ;; Figure out number-to-id mapping for kernel functions in `primitive'
-  (let ([bindings
-         (let ([ns (make-base-empty-namespace)])
-           (parameterize ([current-namespace ns])
-             (namespace-require ''#%kernel)
-             (namespace-require ''#%unsafe)
-             (namespace-require ''#%flfxnum)
-             (namespace-require ''#%extfl)
-             (namespace-require ''#%futures)
-             (namespace-require ''#%foreign)
-             (for/list ([l (namespace-mapped-symbols)])
-               (cons l (with-handlers ([exn:fail? (lambda (x) #f)])
-                         (compile l))))))]
-        [table (make-hash)])
-    (for ([b (in-list bindings)])
-      (let ([v (and (cdr b)
-                    (zo-parse 
-                     (open-input-bytes
-                      (with-output-to-bytes
-                          (λ () (write (cdr b)))))))])
-        (let ([n (match v
-                   [(struct compilation-top (_ _ prefix (struct primval (n)))) n]
-                   [else #f])])
-          (hash-set! table n (car b)))))
-    table))
-
-(define (list-ref/protect l pos who)
-  (list-ref l pos)
-  #;
-  (if (pos . < . (length l))
-      (list-ref l pos)
-      `(OUT-OF-BOUNDS ,who ,pos ,(length l) ,l)))
-
-;; ----------------------------------------
-
-(define-struct glob-desc (vars num-tls num-stxs num-lifts))
-
-;; Main entry:
-(define (decompile top)
-  (let ([stx-ht (make-hasheq)])
-    (match top
-      [(struct compilation-top (max-let-depth binding-namess prefix form))
-       (let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
-         (expose-module-path-indexes
-          `(begin
-            ,@defns
-            ,(decompile-form form globs '(#%globals) (make-hasheq) stx-ht))))]
-      [else (error 'decompile "unrecognized: ~e" top)])))
-
-(define (expose-module-path-indexes e)
-  ;; This is a nearly general replace-in-graph function. (It seems like a lot
-  ;; of work to expose module path index content and sharing, though.)
-  (define ht (make-hasheq))
-  (define mconses null)
-  (define (x-mcons a b)
-    (define m (mcons a b))
-    (set! mconses (cons (cons m (cons a b)) mconses))
-    m)
-  (define main
-    (let loop ([e e])
-      (cond
-       [(hash-ref ht e #f)]
-       [(module-path-index? e)
-        (define ph (make-placeholder #f))
-        (hash-set! ht e ph)
-        (define-values (name base) (module-path-index-split e))
-        (placeholder-set! ph (x-mcons '#%modidx
-                                      (x-mcons (loop name)
-                                               (x-mcons (loop base)
-                                                        null))))
-        ph]
-       [(pair? e)
-        (define ph (make-placeholder #f))
-        (hash-set! ht e ph)
-        (placeholder-set! ph (cons (loop (car e))
-                                   (loop (cdr e))))
-        ph]
-       [(mpair? e)
-        (define m (mcons #f #f))
-        (hash-set! ht e m)
-        (set! mconses (cons (cons m (cons (loop (mcar e))
-                                          (loop (mcdr e))))
-                            mconses))
-        m]
-       [(box? e)
-        (define ph (make-placeholder #f))
-        (hash-set! ht e ph)
-        (placeholder-set! ph (box (loop (unbox e))))
-        ph]
-       [(vector? e)
-        (define ph (make-placeholder #f))
-        (hash-set! ht e ph)
-        (placeholder-set! ph
-                          (for/vector #:length (vector-length e) ([i (in-vector e)])
-                                      (loop i)))
-        ph]
-       [(hash? e)
-        (define ph (make-placeholder #f))
-        (hash-set! ht e ph)
-        (placeholder-set! ph
-                          ((cond
-                            [(hash-eq? ht)
-                             make-hasheq-placeholder]
-                            [(hash-eqv? ht)
-                             make-hasheqv-placeholder]
-                            [else make-hash-placeholder])
-                           (for/list ([(k v) (in-hash e)])
-                             (cons (loop k) (loop v)))))
-        ph]
-       [(prefab-struct-key e)
-        => (lambda (k)
-             (define ph (make-placeholder #f))
-             (hash-set! ht e ph)
-             (placeholder-set! ph
-                               (apply make-prefab-struct
-                                      k
-                                      (map loop
-                                           (cdr (vector->list (struct->vector e))))))
-             ph)]
-       [else
-        e])))
-  (define l (make-reader-graph (cons main mconses)))
-  (for ([i (in-list (cdr l))])
-    (set-mcar! (car i) (cadr i))
-    (set-mcdr! (car i) (cddr i)))
-  (car l))
-
-(define (decompile-prefix a-prefix stx-ht)
-  (match a-prefix
-    [(struct prefix (num-lifts toplevels stxs src-insp-desc))
-     (let ([lift-ids (for/list ([i (in-range num-lifts)])
-                       (gensym 'lift))]
-           [stx-ids (map (lambda (i) (gensym 'stx)) 
-                         stxs)])
-       (values (glob-desc 
-                (append 
-                 (map (lambda (tl)
-                        (match tl
-                          [#f '#%linkage]
-                          [(? symbol?) (string->symbol (format "_~a" tl))]
-                          [(struct global-bucket (name)) 
-                           (string->symbol (format "_~a" name))]
-                          [(struct module-variable (modidx sym pos phase constantness))
-                           (if (and (module-path-index? modidx)
-                                    (let-values ([(n b) (module-path-index-split modidx)])
-                                      (and (not n) (not b))))
-                               (string->symbol (format "_~a" sym))
-                               (string->symbol (format "_~s~a@~s~a" 
-                                                       sym 
-                                                       (match constantness
-                                                         ['constant ":c"]
-                                                         ['fixed ":f"]
-                                                         [(function-shape a pm?) 
-                                                          (if pm? ":P" ":p")]
-                                                         [(struct-type-shape c) ":t"]
-                                                         [(constructor-shape a) ":mk"]
-                                                         [(predicate-shape) ":?"]
-                                                         [(accessor-shape c) ":ref"]
-                                                         [(mutator-shape c) ":set!"]
-                                                         [else ""])
-                                                       (mpi->string modidx) 
-                                                       (if (zero? phase)
-                                                           ""
-                                                           (format "/~a" phase)))))]
-                          [else (error 'decompile-prefix "bad toplevel: ~e" tl)]))
-                      toplevels)
-                 stx-ids
-                 (if (null? stx-ids) null '(#%stx-array))
-                 lift-ids)
-                (length toplevels)
-                (length stxs)
-                num-lifts)
-               (list*
-                `(quote inspector ,src-insp-desc)
-                ;; `(quote tls ,toplevels)
-                (map (lambda (stx id)
-                       `(define ,id ,(if stx
-                                         `(#%decode-syntax 
-                                           ,(decompile-stx (stx-content stx) stx-ht))
-                                         #f)))
-                     stxs stx-ids))))]
-    [else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
-
-(define (decompile-stx stx stx-ht)
-  (or (hash-ref stx-ht stx #f)
-      (let ([p (mcons #f #f)])
-        (hash-set! stx-ht stx p)
-        (match stx
-          [(stx-obj datum wrap srcloc props tamper-status)
-           (set-mcar! p (case tamper-status
-                          [(clean) 'wrap]
-                          [(tainted) 'wrap-tainted]
-                          [(armed) 'wrap-armed]))
-           (set-mcdr! p (mcons
-                         (cond
-                          [(pair? datum) 
-                           (cons (decompile-stx (car datum) stx-ht)
-                                 (let loop ([l (cdr datum)])
-                                   (cond
-                                    [(null? l) null]
-                                    [(pair? l)
-                                     (cons (decompile-stx (car l) stx-ht)
-                                           (loop (cdr l)))]
-                                    [else
-                                     (decompile-stx l stx-ht)])))]
-                          [(vector? datum)
-                           (for/vector ([e (in-vector datum)])
-                             (decompile-stx e stx-ht))]
-                          [(box? datum)
-                           (box (decompile-stx (unbox datum) stx-ht))]
-                          [else datum])
-                         (let* ([l (mcons wrap null)]
-                                [l (if (hash-count props)
-                                       (mcons props l)
-                                       l)]
-                                [l (if srcloc
-                                       (mcons srcloc l)
-                                       l)])
-                           l)))
-           p]))))
-
-(define (mpi->string modidx)
-  (cond
-   [(symbol? modidx) modidx]
-   [else 
-    (collapse-module-path-index modidx)]))
-
-(define (decompile-module mod-form orig-stack stx-ht mod-name)
-  (match mod-form
-    [(struct mod (name srcname self-modidx
-                       prefix provides requires body syntax-bodies unexported 
-                       max-let-depth dummy lang-info 
-                       internal-context binding-names
-                       flags pre-submodules post-submodules))
-     (let-values ([(globs defns) (decompile-prefix prefix stx-ht)]
-                  [(stack) (append '(#%modvars) orig-stack)]
-                  [(closed) (make-hasheq)])
-       `(,mod-name ,(if (symbol? name) name (last name)) ....
-           (quote self ,self-modidx)
-           (quote internal-context 
-                  ,(if (stx? internal-context)
-                       `(#%decode-syntax 
-                         ,(decompile-stx (stx-content internal-context) stx-ht))
-                       internal-context))
-           (quote bindings ,(for/hash ([(phase ht) (in-hash binding-names)])
-                              (values phase
-                                      (for/hash ([(sym id) (in-hash ht)])
-                                        (values sym
-                                                (if (eq? id #t)
-                                                    #t
-                                                    `(#%decode-syntax 
-                                                      ,(decompile-stx (stx-content id) stx-ht))))))))
-           (quote language-info ,lang-info)
-           ,@(if (null? flags) '() (list `(quote ,flags)))
-           ,@(let ([l (apply
-                       append
-                       (for/list ([req (in-list requires)]
-                                  #:when (pair? (cdr req)))
-                         (define l (for/list ([mpi (in-list (cdr req))])
-                                     (define p (mpi->string mpi))
-                                     (if (path? p)
-                                         (let ([d (current-load-relative-directory)])
-                                           (path->string (if d
-                                                             (find-relative-path (simplify-path d #t)
-                                                                                 (simplify-path p #f) 
-                                                                                 #:more-than-root? #t)
-                                                             p)))
-                                         p)))
-                         (if (eq? 0 (car req))
-                             l
-                             `((,@(case (car req)
-                                    [(#f) `(for-label)]
-                                    [(1) `(for-syntax)]
-                                    [else `(for-meta ,(car req))])
-                                ,@l)))))])
-               (if (null? l)
-                   null
-                   `((require ,@l))))
-           (provide ,@(apply
-                       append
-                       (for/list ([p (in-list provides)])
-                         (define phase (car p))
-                         (define l
-                           (for/list ([pv (in-list (append (cadr p) (caddr p)))])
-                             (match pv
-                               [(struct provided (name src src-name nom-src src-phase protected?))
-                                (define n (if (eq? name src-name)
-                                              name
-                                              `(rename-out [,src-name ,name])))
-                                (if protected?
-                                    `(protect-out ,n)
-                                    n)])))
-                         (if (or (null? l) (eq? phase 0))
-                             l
-                             `((,@(case phase
-                                    [(#f) `(for-label)]
-                                    [(1) `(for-syntax)]
-                                    [else `(for-meta ,phase)])
-                                ,@l))))))
-          ,@defns
-          ,@(for/list ([submod (in-list pre-submodules)])
-              (decompile-module submod orig-stack stx-ht 'module))
-          ,@(for/list ([b (in-list syntax-bodies)])
-              (let loop ([n (sub1 (car b))])
-                (if (zero? n)
-                    (cons 'begin
-                          (for/list ([form (in-list (cdr b))])
-                            (decompile-form form globs stack closed stx-ht)))
-                    (list 'begin-for-syntax (loop (sub1 n))))))
-          ,@(map (lambda (form)
-                   (decompile-form form globs stack closed stx-ht))
-                 body)
-          ,@(for/list ([submod (in-list post-submodules)])
-              (decompile-module submod orig-stack stx-ht 'module*))))]
-    [else (error 'decompile-module "huh?: ~e" mod-form)]))
-
-(define (decompile-form form globs stack closed stx-ht)
-  (match form
-    [(? mod?)
-     (decompile-module form stack stx-ht 'module)]
-    [(struct def-values (ids rhs))
-     `(define-values ,(map (lambda (tl)
-                             (match tl
-                               [(struct toplevel (depth pos const? set-const?))
-                                (list-ref/protect (glob-desc-vars globs) pos 'def-vals)]))
-                           ids)
-        ,(if (inline-variant? rhs)
-             `(begin
-                ,(list 'quote '%%inline-variant%%)
-                ,(decompile-expr (inline-variant-inline rhs) globs stack closed)
-                ,(decompile-expr (inline-variant-direct rhs) globs stack closed))
-             (decompile-expr rhs globs stack closed)))]
-    [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
-     `(define-syntaxes ,ids
-        ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
-           `(let ()
-              ,@defns
-              ,(decompile-form rhs globs '(#%globals) closed stx-ht))))]
-    [(struct seq-for-syntax (exprs prefix max-let-depth dummy))
-     `(begin-for-syntax
-       ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
-          `(let ()
-             ,@defns
-             ,@(for/list ([rhs (in-list exprs)])
-                 (decompile-form rhs globs '(#%globals) closed stx-ht)))))]
-    [(struct seq (forms))
-     `(begin ,@(map (lambda (form)
-                      (decompile-form form globs stack closed stx-ht))
-                    forms))]
-    [(struct splice (forms))
-     `(begin ,@(map (lambda (form)
-                      (decompile-form form globs stack closed stx-ht))
-                    forms))]
-    [(struct req (reqs dummy))
-     `(#%require . (#%decode-syntax ,reqs))]
-    [else
-     (decompile-expr form globs stack closed)]))
-
-(define (extract-name name)
-  (if (symbol? name)
-      (gensym name)
-      (if (vector? name)
-          (gensym (vector-ref name 0))
-          #f)))
-
-(define (extract-id expr)
-  (match expr
-    [(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
-     (extract-name name)]
-    [(struct case-lam (name lams))
-     (extract-name name)]
-    [(struct closure (lam gen-id))
-     (extract-id lam)]
-    [else #f]))
-
-(define (extract-ids! body ids)
-  (match body
-    [(struct let-rec (procs body))
-     (for ([proc (in-list procs)]
-           [delta (in-naturals)])
-       (when (< -1 delta (vector-length ids))
-         (vector-set! ids delta (extract-id proc))))
-     (extract-ids! body ids)]
-    [(struct install-value (val-count pos boxes? rhs body))
-     (extract-ids! body ids)]
-    [(struct boxenv (pos body))
-     (extract-ids! body ids)]
-    [else #f]))
-
-(define (decompile-tl expr globs stack closed no-check?)
-  (match expr
-    [(struct toplevel (depth pos const? ready?))
-     (let ([id (list-ref/protect (glob-desc-vars globs) pos 'toplevel)])
-       (cond
-        [no-check? id]
-        [(and (not const?) (not ready?))
-         `(#%checked ,id)]
-        #;[(and const? ready?) `(#%const ,id)]
-        #;[const? `(#%iconst ,id)]
-        [else id]))]))
-
-(define (decompile-expr expr globs stack closed)
-  (match expr
-    [(struct toplevel (depth pos const? ready?))
-     (decompile-tl expr globs stack closed #f)]
-    [(struct varref (tl dummy))
-     `(#%variable-reference ,(if (eq? tl #t)
-                                 '<constant-local>
-                                 (decompile-tl tl globs stack closed #t)))]
-    [(struct topsyntax (depth pos midpt))
-     (list-ref/protect (glob-desc-vars globs) (+ midpt pos) 'topsyntax)]
-    [(struct primval (id))
-     (hash-ref primitive-table id (lambda () (error "unknown primitive: " id)))]
-    [(struct assign (id rhs undef-ok?))
-     `(set! ,(decompile-expr id globs stack closed)
-            ,(decompile-expr rhs globs stack closed))]
-    [(struct localref (unbox? offset clear? other-clears? type))
-     (let ([id (list-ref/protect stack offset 'localref)])
-       (let ([e (if unbox?
-                    `(#%unbox ,id)
-                    id)])
-         (if clear?
-             `(#%sfs-clear ,e)
-             e)))]
-    [(? lam?)
-     `(lambda . ,(decompile-lam expr globs stack closed))]
-    [(struct case-lam (name lams))
-     `(case-lambda
-       ,@(map (lambda (lam)
-                (decompile-lam lam globs stack closed))
-              lams))]
-    [(struct let-one (rhs body type unused?))
-     (let ([id (or (extract-id rhs)
-                   (gensym (or type (if unused? 'unused 'local))))])
-       `(let ([,id ,(decompile-expr rhs globs (cons id stack) closed)])
-          ,(decompile-expr body globs (cons id stack) closed)))]
-    [(struct let-void (count boxes? body))
-     (let ([ids (make-vector count #f)])
-       (extract-ids! body ids)
-       (let ([vars (for/list ([i (in-range count)]
-                              [id (in-vector ids)])
-                     (or id (gensym (if boxes? 'localvb 'localv))))])
-         `(let ,(map (lambda (i) `[,i ,(if boxes? `(#%box ?) '?)])
-                     vars)
-            ,(decompile-expr body globs (append vars stack) closed))))]
-    [(struct let-rec (procs body))
-     `(begin
-        (#%set!-rec-values ,(for/list ([p (in-list procs)]
-                                       [i (in-naturals)])
-                              (list-ref/protect stack i 'let-rec))
-                           ,@(map (lambda (proc)
-                                    (decompile-expr proc globs stack closed))
-                                  procs))
-        ,(decompile-expr body globs stack closed))]
-    [(struct install-value (count pos boxes? rhs body))
-     `(begin
-        (,(if boxes? '#%set-boxes! 'set!-values)
-         ,(for/list ([i (in-range count)])
-            (list-ref/protect stack (+ i pos) 'install-value))
-         ,(decompile-expr rhs globs stack closed))
-        ,(decompile-expr body globs stack closed))]
-    [(struct boxenv (pos body))
-     (let ([id (list-ref/protect stack pos 'boxenv)])
-       `(begin
-          (set! ,id (#%box ,id))
-          ,(decompile-expr body globs stack closed)))]
-    [(struct branch (test then else))
-     `(if ,(decompile-expr test globs stack closed)
-          ,(decompile-expr then globs stack closed)
-          ,(decompile-expr else globs stack closed))]
-    [(struct application (rator rands))
-     (let ([stack (append (for/list ([i (in-list rands)]) (gensym 'rand))
-                          stack)])
-       (annotate-unboxed
-        rands
-        (annotate-inline
-         `(,(decompile-expr rator globs stack closed)
-           ,@(map (lambda (rand)
-                    (decompile-expr rand globs stack closed))
-                  rands)))))]
-    [(struct apply-values (proc args-expr))
-     `(#%apply-values ,(decompile-expr proc globs stack closed) 
-                      ,(decompile-expr args-expr globs stack closed))]
-    [(struct with-immed-mark (key-expr val-expr body-expr))
-     (let ([id (gensym 'cmval)])
-       `(#%call-with-immediate-continuation-mark
-         ,(decompile-expr key-expr globs stack closed)
-         (lambda (,id) ,(decompile-expr body-expr globs (cons id stack) closed))
-         ,(decompile-expr val-expr globs stack closed)))]
-    [(struct seq (exprs))
-     `(begin ,@(for/list ([expr (in-list exprs)])
-                 (decompile-expr expr globs stack closed)))]
-    [(struct beg0 (exprs))
-     `(begin0
-       ,@(for/list ([expr (in-list exprs)])
-           (decompile-expr expr globs stack closed))
-       ;; Make sure a single expression doesn't look like tail position:
-       ,@(if (null? (cdr exprs)) (list #f) null))]
-    [(struct with-cont-mark (key val body))
-     `(with-continuation-mark
-          ,(decompile-expr key globs stack closed)
-          ,(decompile-expr val globs stack closed)
-          ,(decompile-expr body globs stack closed))]
-    [(struct closure (lam gen-id))
-     (if (hash-ref closed gen-id #f)
-         gen-id
-         (begin
-           (hash-set! closed gen-id #t)
-           `(#%closed ,gen-id ,(decompile-expr lam globs stack closed))))]
-    [else `(quote ,expr)]))
-
-(define (decompile-lam expr globs stack closed)
-  (match expr
-    [(struct closure (lam gen-id)) (decompile-lam lam globs stack closed)]
-    [(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
-     (let ([vars (for/list ([i (in-range num-params)]
-                            [type (in-list arg-types)])
-                   (gensym (format "~a~a-" 
-                                   (case type 
-                                     [(ref) "argbox"] 
-                                     [(val) "arg"]
-                                     [else (format "arg~a" type)])
-                                   i)))]
-           [rest-vars (if rest? (list (gensym 'rest)) null)]
-           [captures (map (lambda (v)
-                            (list-ref/protect stack v 'lam))
-                          (vector->list closure-map))])
-       `((,@vars . ,(if rest?
-                        (car rest-vars)
-                        null))
-         ,@(if (and name (not (null? name)))
-               `(',name)
-               null)
-         ,@(if (null? flags) null `('(flags: ,@flags)))
-         ,@(if (null? captures)
-               null
-               `('(captures: ,@(map (lambda (c t)
-                                      (if t
-                                          `(,t ,c)
-                                          c))
-                                    captures
-                                    closure-types)
-                             ,@(if (not tl-map)
-                                   '()
-                                   (list
-                                    (for/list ([pos (in-list (sort (set->list tl-map) <))])
-                                      (define tl-pos
-                                        (cond
-                                         [(or (pos . < . (glob-desc-num-tls globs))
-                                              (zero? (glob-desc-num-stxs globs)))
-                                          pos]
-                                         [(= pos (glob-desc-num-tls globs))
-                                          'stx]
-                                         [else
-                                          (+ pos (glob-desc-num-stxs globs))]))
-                                      (if (eq? tl-pos 'stx)
-                                          '#%syntax
-                                          (list-ref/protect (glob-desc-vars globs)
-                                                            tl-pos
-                                                            'lam))))))))
-         ,(decompile-expr body globs
-                          (append captures
-                                  (append vars rest-vars))
-                          closed)))]))
-
-(define (annotate-inline a)
-  a)
-
-(define (annotate-unboxed args a)
-  a)
-
-;; ----------------------------------------
-
-#;
-(begin
-  (require scheme/pretty)
-  (define (try e)
-    (pretty-print
-     (decompile
-      (zo-parse (let-values ([(in out) (make-pipe)])
-                  (write (parameterize ([current-namespace (make-base-namespace)])
-                           (compile e))
-                         out)
-                  (close-output-port out)
-                  in)))))
-  (pretty-print
-   (decompile
-    (zo-parse (open-input-file "/home/mflatt/proj/plt/collects/tests/mzscheme/benchmarks/common/sboyer_ss.zo"))))
-  #;
-  (try '(lambda (q . more)
-          (letrec ([f (lambda (x) f)])
-            (lambda (g) f)))))

pkgs/compiler-lib/compiler/demodularizer/alpha.rkt

@@ -1,20 +0,0 @@
-#lang racket/base
-
-(require racket/match racket/contract compiler/zo-parse)
-
-(define (alpha-vary-ctop top)
-  (match top
-    [(struct compilation-top (max-let-depth binding-namess prefix form))
-     (make-compilation-top max-let-depth binding-namess (alpha-vary-prefix prefix) form)]))
-(define (alpha-vary-prefix p)
-  (struct-copy prefix p
-               [toplevels
-                (map (match-lambda
-                       [(and sym (? symbol?))
-                        (gensym sym)]
-                       [other
-                        other])
-                     (prefix-toplevels p))]))
-
-(provide/contract
- [alpha-vary-ctop (compilation-top? . -> . compilation-top?)])

pkgs/compiler-lib/compiler/demodularizer/batch.rkt

@@ -1,63 +0,0 @@
-#lang racket/base
-
-#|
-Here's the idea:
-
-- Take a module's bytecode
-- Recursively get all the bytecode for modules that the target requires
-- After reading it, prune everything that isn't at phase 0 (the runtime phase)
-
-- Now that we have all the modules, the next step is to merge them into a single
-  module
--- Although actually we collapse them into the top-level, not a module
-- To do that, we iterate through all the modules doing two things as we go:
--- Incrementing all the global variable references by all the references in all
-   the modules
---- So if A has 5, then B's start at index 5 and so on
--- Replacing module variable references with the actual global variables
-   corresponding to those variables
---- So if A's variable 'x' is in global slot 4, then if B refers to it, it 
-    directly uses slot 4, rather than a module-variable slot
-
-- At that point we have all the module code in a single top-level, but many
-  toplevels won't be used because a library function isn't really used
-- So, we do a "garbage collection" on elements of the prefix
-- First, we create a dependency graph of all toplevels and the initial scope
-- Then, we do a DFS on the initial scope and keep all those toplevels, throwing
-  away the construction of everything else
-  [XXX: This may be broken because of side-effects.]
-
-- Now we have a small amount code, but because we want to go back to source,
-  we need to fix it up a bit; because different modules may've used the same
-  names
-- So, we do alpha-renaming, but it's easy because names are only used in the
-  compilation-top prefix structure
-
-[TODO]
-
-- Next, we decompile
-- Then, it will pay to do dead code elimination and inlining, etc.
-|#
-
-(require racket/cmdline
-         racket/set
-         raco/command-name
-         "main.rkt")
-
-
-(let ([output-file (make-parameter #f)])
-  (command-line #:program (short-program+command-name)
-                #:multi
-                [("-e" "--exclude-modules") path "Exclude <path> from flattening"
-                 (current-excluded-modules (set-add (current-excluded-modules) path))]
-                #:once-each
-                [("-o") dest-filename "Write output as <dest-filename>"
-                 (output-file (string->path dest-filename))]
-                [("-g" "--garbage-collect") "Garbage-collect final module (unsound)"
-                 (garbage-collect-toplevels-enabled #t)]                         
-                [("-r" "--recompile") "Recompile final module to re-run optimizations"
-                 (recompile-enabled #t)]                         
-                #:args (filename) 
-                (demodularize filename (output-file))))
-
-(module test racket/base)

pkgs/compiler-lib/compiler/demodularizer/gc-toplevels.rkt

@@ -1,288 +0,0 @@
-#lang racket/base
-
-(require racket/match
-         racket/list
-         racket/dict
-         racket/contract
-         compiler/zo-parse
-         "util.rkt")
-
-; XXX Use efficient set structure
-(define (gc-toplevels top)
-  (match top
-    [(struct compilation-top (max-let-depth binding-namess top-prefix form))
-     (define lift-start
-       (prefix-lift-start top-prefix))
-     (define max-depgraph-index 
-       (+ (prefix-num-lifts top-prefix)
-          lift-start))
-     (define top-node max-depgraph-index)
-     (define DEP-GRAPH (make-vector (add1 top-node) (make-refs empty empty)))
-     (define build-graph! (make-build-graph! DEP-GRAPH))
-     (define _void (build-graph! (list top-node) form))
-     (define-values (used-tls stxs) (graph-dfs DEP-GRAPH top-node))
-     (define ordered-used-tls (sort (rest used-tls) <=)) ; This rest drops off the top-node
-     (define ordered-stxs (sort stxs <=))
-     (define (lift? i) (lift-start . <= . i))
-     (define-values (lifts normal-tls) (partition lift? ordered-used-tls))
-     (define new-prefix
-       (make-prefix 
-        (length lifts)
-        (for/list ([i normal-tls])
-          (list-ref (prefix-toplevels top-prefix) i))
-        (for/list ([i ordered-stxs])
-          (list-ref (prefix-stxs top-prefix) i))))
-     (define new-lift-start
-       (prefix-lift-start new-prefix))
-     ; XXX This probably breaks max-let-depth
-     (define new-form
-       ((gc-toplevels-form 
-         (lambda (pos) (index<=? pos ordered-used-tls))
-         (lambda (pos)
-           (if (lift? pos)
-               (+ new-lift-start (index<=? pos lifts))
-               (index<=? pos normal-tls)))
-         (lambda (stx-pos)
-           (index<=? stx-pos ordered-stxs))
-         (prefix-syntax-start new-prefix))
-        form))
-     (log-debug (format "Total TLS: ~S" (length normal-tls)))
-     (log-debug (format "Used TLS: ~S" normal-tls))
-     (log-debug (format "Total lifts: ~S" (length lifts)))
-     (log-debug (format "Used lifts: ~S" lifts))
-     (log-debug (format "Total stxs: ~S" (length stxs)))
-     (log-debug (format "Used stxs: ~S" ordered-stxs))
-     (make-compilation-top
-      max-let-depth
-      #hash()
-      new-prefix
-      new-form)]))
-
-(define-struct refs (tl stx) #:transparent)
-
-(define (make-build-graph! DEP-GRAPH)
-  (define (build-graph!* form lhs)
-    (match form
-      [(struct def-values (ids rhs))
-       (define new-lhs (map toplevel-pos ids))
-       ; If we require one, we should require all, so make them reference each other
-       (for-each (lambda (tl) (build-graph! new-lhs tl)) ids)
-       (build-graph! new-lhs rhs)]
-      [(? def-syntaxes?)
-       (error 'build-graph "Doesn't handle syntax")]
-      [(? seq-for-syntax?)
-       (error 'build-graph "Doesn't handle syntax")]
-      [(struct inline-variant (direct inline))
-       (build-graph! lhs direct)]
-      [(struct req (reqs dummy))
-       (build-graph! lhs dummy)]
-      [(? mod?)
-       (error 'build-graph "Doesn't handle modules")]
-      [(struct seq (forms))
-       (for-each (lambda (f) (build-graph! lhs f)) forms)]
-      [(struct splice (forms))
-       (for-each (lambda (f) (build-graph! lhs f)) forms)]
-      [(and l (struct lam (name flags num-params param-types rest? closure-map closure-types tl-map max-let-depth body)))
-       (build-graph! lhs body)]
-      [(and c (struct closure (code gen-id)))
-       (build-graph! lhs code)]
-      [(and cl (struct case-lam (name clauses)))
-       (for-each (lambda (l) (build-graph! lhs l))
-                 clauses)]
-      [(struct let-one (rhs body flonum? unused?))
-       (build-graph! lhs rhs)
-       (build-graph! lhs body)]
-      [(and f (struct let-void (count boxes? body)))
-       (build-graph! lhs body)]
-      [(and f (struct install-value (_ _ _ rhs body)))
-       (build-graph! lhs rhs)
-       (build-graph! lhs body)]
-      [(struct let-rec (procs body))
-       (for-each (lambda (l) (build-graph! lhs l)) procs)
-       (build-graph! lhs body)]
-      [(and f (struct boxenv (_ body)))
-       (build-graph! lhs body)]
-      [(and f (struct toplevel (_ pos _ _)))
-       (for-each (lambda (lhs)
-                   (dict-update! DEP-GRAPH lhs
-                                 (match-lambda 
-                                   [(struct refs (tls stxs))
-                                    (make-refs (list* pos tls) stxs)])))
-                 lhs)]
-      [(and f (struct topsyntax (_ pos _)))
-       (for-each (lambda (lhs)
-                   (dict-update! DEP-GRAPH lhs
-                                 (match-lambda 
-                                   [(struct refs (tls stxs))
-                                    (make-refs tls (list* pos stxs))])))
-                 lhs)]
-      [(struct application (rator rands))
-       (for-each (lambda (f) (build-graph! lhs f))
-                 (list* rator rands))]
-      [(struct branch (test then else))
-       (for-each (lambda (f) (build-graph! lhs f))
-                 (list test then else))]
-      [(struct with-cont-mark (key val body))
-       (for-each (lambda (f) (build-graph! lhs f))
-                 (list key val body))]
-      [(struct with-immed-mark (key val body))
-       (for-each (lambda (f) (build-graph! lhs f))
-                 (list key val body))]
-      [(struct beg0 (seq))
-       (for-each (lambda (f) (build-graph! lhs f))
-                 seq)]
-      [(struct varref (tl dummy))
-       (build-graph! lhs tl)
-       (build-graph! lhs dummy)]
-      [(and f (struct assign (id rhs undef-ok?)))
-       (build-graph! lhs id)
-       (build-graph! lhs rhs)]
-      [(struct apply-values (proc args-expr))
-       (build-graph! lhs proc)
-       (build-graph! lhs args-expr)]
-      [(and f (struct primval (id)))
-       (void)]
-      [(and f (struct localref (unbox? pos clear? other-clears? type)))
-       (void)]
-      [(and v (not (? form?)))
-       (void)]))
-  (define-values (first-build-graph!** build-graph!**) 
-    (build-form-memo build-graph!* #:void? #t))
-  (define (build-graph! lhs form) (first-build-graph!** form lhs))
-  build-graph!)
-
-(define (graph-dfs g start-node)
-  (define visited? (make-hasheq))
-  (define (visit-tl n tls stxs)
-    (if (hash-has-key? visited? n)
-        (values tls stxs)
-        (match (dict-ref g n)
-          [(struct refs (n-tls n-stxs))
-           (hash-set! visited? n #t)
-           (define-values (new-tls1 new-stxs1)
-             (for/fold ([new-tls tls]
-                        [new-stxs stxs])
-                       ([tl (in-list n-tls)])
-               (visit-tl tl new-tls new-stxs)))
-           (define new-stxs2
-             (for/fold ([new-stxs new-stxs1])
-                       ([stx (in-list n-stxs)])
-               (define this-stx (visit-stx stx))
-               (if this-stx
-                   (list* this-stx new-stxs)
-                   new-stxs)))
-           (values (list* n new-tls1)
-                   new-stxs2)])))
-  (define stx-visited? (make-hasheq))
-  (define (visit-stx n)
-    (if (hash-has-key? stx-visited? n)
-        #f
-        (begin (hash-set! stx-visited? n #t)
-               n)))
-  (visit-tl start-node empty empty))
-
-; index<=? : number? (listof number?) -> (or/c number? false/c)
-; returns the index of n in l and assumes that l is sorted by <=
-(define (index<=? n l)
-  (match l
-    [(list) #f]
-    [(list-rest f l)
-     (cond
-       [(= n f)
-        0]
-       [(< n f)
-        #f]
-       [else
-        (let ([rec (index<=? n l)])
-          (if rec (add1 rec) rec))])]))
-
-(define (identity x) x)
-(define (gc-toplevels-form keep? update-tl update-ts new-ts-midpt)
-  (define (inner-update form)
-    (match form
-      [(struct def-values (ids rhs))
-       (if (ormap (compose keep? toplevel-pos) ids)
-           (make-def-values (map update ids)
-                            (update rhs))
-           #f)]
-      [(? def-syntaxes?)
-       (error 'gc-tls "Doesn't handle syntax")]
-      [(? seq-for-syntax?)
-       (error 'gc-tls "Doesn't handle syntax")]
-      [(struct req (reqs dummy))
-       (make-req reqs (update dummy))]
-      [(? mod?)
-       (error 'gc-tls "Doesn't handle modules")]
-      [(struct seq (forms))
-       (make-seq (filter identity (map update forms)))]
-      [(struct splice (forms))
-       (make-splice (filter identity (map update forms)))]
-      [(and l (struct lam (name flags num-params param-types rest? closure-map closure-types tl-map max-let-depth body)))
-       (struct-copy lam l
-                    [toplevel-map #f] ; consevrative
-                    [body (update body)])]
-      [(and c (struct closure (code gen-id)))
-       (struct-copy closure c
-                    [code (update code)])]
-      [(and cl (struct case-lam (name clauses)))
-       (struct-copy case-lam cl
-                    [clauses (map update clauses)])]
-      [(struct let-one (rhs body type unused?))
-       (make-let-one (update rhs) (update body) type unused?)]
-      [(and f (struct let-void (count boxes? body)))
-       (struct-copy let-void f
-                    [body (update body)])]
-      [(and f (struct install-value (_ _ _ rhs body)))
-       (struct-copy install-value f
-                    [rhs (update rhs)]
-                    [body (update body)])]
-      [(struct let-rec (procs body))
-       (make-let-rec (map update procs) (update body))]
-      [(and f (struct boxenv (_ body)))
-       (struct-copy boxenv f [body (update body)])]
-      [(and f (struct toplevel (_ pos _ _)))
-       (struct-copy toplevel f
-                    [pos (update-tl pos)])]
-      [(and f (struct topsyntax (_ pos _)))
-       (struct-copy topsyntax f
-                    [pos (update-ts pos)]
-                    [midpt new-ts-midpt])]
-      [(struct application (rator rands))
-       (make-application 
-        (update rator)
-        (map update rands))]
-      [(struct branch (test then else))
-       (make-branch 
-        (update test)
-        (update then)
-        (update else))]
-      [(struct with-cont-mark (key val body))
-       (make-with-cont-mark 
-        (update key)
-        (update val)
-        (update body))]
-      [(struct beg0 (seq))
-       (make-beg0 (map update seq))]
-      [(struct varref (tl dummy))
-       (make-varref (update tl) (update dummy))]
-      [(and f (struct assign (id rhs undef-ok?)))
-       (struct-copy assign f
-                    [id (update id)]
-                    [rhs (update rhs)])]
-      [(struct apply-values (proc args-expr))
-       (make-apply-values
-        (update proc)
-        (update args-expr))]
-      [(and f (struct primval (id)))
-       f]
-      [(and f (struct localref (unbox? pos clear? other-clears? type)))
-       f]
-      [(and v (not (? form?)))
-       v]
-      ))
-  (define-values (first-update update)
-    (build-form-memo inner-update))
-  first-update)
-
-(provide/contract
- [gc-toplevels (compilation-top? . -> . compilation-top?)])

pkgs/compiler-lib/compiler/demodularizer/info.rkt

@@ -1,3 +0,0 @@
-#lang info
-
-(define test-responsibles '((all jay)))

pkgs/compiler-lib/compiler/demodularizer/main.rkt

@@ -1,91 +0,0 @@
-#lang racket/base
-(require compiler/cm
-         compiler/zo-marshal
-         "alpha.rkt"
-         "gc-toplevels.rkt"
-         "merge.rkt"
-         "module.rkt"
-         "mpi.rkt"
-         "nodep.rkt"
-         "replace-modidx.rkt")
-
-(provide current-excluded-modules
-         garbage-collect-toplevels-enabled
-         recompile-enabled
-         demodularize)
-
-(define garbage-collect-toplevels-enabled (make-parameter #f))
-(define recompile-enabled (make-parameter #f))
-
-(define logger (make-logger 'demodularizer (current-logger)))
-
-(define (demodularize file-to-batch [output-file #f])
-  (parameterize ([current-logger logger])
-    (define-values (base name must-be-dir?) (split-path file-to-batch))
-    (when must-be-dir?
-      (error 'demodularize "Cannot run on directory: ~a" file-to-batch))
-    (unless (file-exists? file-to-batch)
-      (error 'demodularize "File does not exist: ~a" file-to-batch))
-    
-    ;; Compile
-    (log-info "Compiling module")
-    (parameterize ([current-namespace (make-base-empty-namespace)])
-      (managed-compile-zo file-to-batch))
-    
-    (define merged-zo-path 
-      (or output-file
-          (path-add-suffix file-to-batch #"_merged.zo")))
-    
-    ;; Transformations
-    (define path-cache (make-hasheq))
-    
-    (log-info "Removing dependencies")
-    (define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite)
-      (parameterize ([MODULE-PATHS path-cache])
-        (nodep-file file-to-batch)))
-    
-    (log-info "Merging modules")
-    (define batch-merge
-      (parameterize ([MODULE-PATHS path-cache])
-        (merge-compilation-top get-modvar-rewrite batch-nodep)))
-    
-    (define batch-gcd
-      (if (garbage-collect-toplevels-enabled)
-          (begin
-            (log-info "GC-ing top-levels")
-            (gc-toplevels batch-merge))
-          batch-merge))
-    
-    (log-info "Alpha-varying top-levels")
-    (define batch-alpha
-      (alpha-vary-ctop batch-gcd))
-    
-    (log-info "Replacing self-modidx")
-    (define batch-replace-modidx
-      (replace-modidx batch-alpha top-self-modidx))
-    
-    (define batch-modname
-      (string->symbol (regexp-replace #rx"\\.zo$" (path->string merged-zo-path) "")))
-    (log-info (format "Modularizing into ~a" batch-modname))
-    (define batch-mod
-      (wrap-in-kernel-module batch-modname batch-modname top-lang-info top-self-modidx batch-replace-modidx))
-    
-    (log-info "Writing merged zo")
-    (void
-     (with-output-to-file 
-         merged-zo-path
-       (lambda ()
-         (zo-marshal-to batch-mod (current-output-port)))
-       #:exists 'replace))
-  
-    (void
-      (when (recompile-enabled)
-        (define recomp
-          (compiled-expression-recompile 
-            (parameterize ([read-accept-compiled #t])
-              (call-with-input-file merged-zo-path read))))
-        (call-with-output-file merged-zo-path
-          (lambda (out)
-            (write recomp out))
-          #:exists 'replace)))))
-

pkgs/compiler-lib/compiler/demodularizer/merge.rkt

@@ -1,229 +0,0 @@
-#lang racket/base
-
-(require racket/list
-         racket/match
-         racket/contract
-         compiler/zo-parse
-         "util.rkt"
-         "mpi.rkt"
-         "nodep.rkt"
-         "update-toplevels.rkt")
-
-(define MODULE-TOPLEVEL-OFFSETS (make-hasheq))
-
-(define current-get-modvar-rewrite (make-parameter #f))
-(define (merge-compilation-top get-modvar-rewrite top)
-  (parameterize ([current-get-modvar-rewrite get-modvar-rewrite])
-    (match top
-      [(struct compilation-top (max-let-depth binding-namess prefix form))
-       (define-values (new-max-let-depth new-prefix gen-new-forms)
-         (merge-form max-let-depth prefix form))
-       (define total-tls (length (prefix-toplevels new-prefix)))
-       (define total-stxs (length (prefix-stxs new-prefix)))
-       (define total-lifts (prefix-num-lifts new-prefix))
-       (log-debug (format "max-let-depth ~S to ~S" max-let-depth new-max-let-depth))
-       (log-debug (format "total toplevels ~S" total-tls))
-       (log-debug (format "total stxs ~S" total-stxs))
-       (log-debug (format "num-lifts ~S" total-lifts))
-       (for ([i (in-naturals)]
-             [p (in-list (prefix-toplevels new-prefix))])
-         (log-debug (format "new-prefix tls\t~v ~v" i p)))
-       (make-compilation-top
-        new-max-let-depth #hash() new-prefix
-        (make-splice (gen-new-forms new-prefix)))]
-      [else (error 'merge "unrecognized: ~e" top)])))
-
-(define (merge-forms max-let-depth prefix forms)
-  (if (empty? forms)
-      (values max-let-depth prefix (lambda _ empty))
-      (let*-values ([(fmax-let-depth fprefix gen-fform) (merge-form max-let-depth prefix (first forms))]
-                    [(rmax-let-depth rprefix gen-rforms) (merge-forms fmax-let-depth fprefix (rest forms))])
-        (values rmax-let-depth
-                rprefix
-                (lambda args
-                  (append (apply gen-fform args)
-                          (apply gen-rforms args)))))))
-
-(define (merge-form max-let-depth prefix form)
-  (match form
-    [(? mod?)
-     (merge-module max-let-depth prefix form)]
-    [(struct seq (forms))
-     (merge-forms max-let-depth prefix forms)]
-    [(struct splice (forms))
-     (merge-forms max-let-depth prefix forms)]
-    [else
-     (values max-let-depth prefix (lambda _ (list form)))]))
-
-(define (index-of v l)
-  (for/or ([e (in-list l)]
-           [i (in-naturals)]
-           #:when (eq? e v))
-    i))
-
-(define (merge-prefix root-prefix mod-prefix)
-  (match-define (struct prefix (root-num-lifts root-toplevels root-stxs root-src-insp-desc)) root-prefix)
-  (match-define (struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc)) mod-prefix)
-  (make-prefix (+ root-num-lifts mod-num-lifts)
-               (append root-toplevels mod-toplevels)
-               (append root-stxs mod-stxs)
-               root-src-insp-desc))
-
-(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
-
-(define (compute-new-modvar mv rw)
-  (match mv
-    [(struct module-variable (modidx sym pos phase constantness))
-     (match rw
-       [(struct modvar-rewrite (self-modidx provide->toplevel))
-        (log-debug (format "Rewriting ~a@~a of ~S" sym pos (mpi->path* modidx)))
-        (define tl (provide->toplevel sym pos))
-        (log-debug (format "Rewriting ~a@~a of ~S to ~S" sym pos (mpi->path* modidx) tl))
-        (match-define (toplevel-offset-rewriter rewrite-fun meta)
-          (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
-                    (lambda ()
-                      (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))))
-        (log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S" sym pos (mpi->path* modidx) tl meta))
-        (define res (rewrite-fun tl))
-        (log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S and got ~S"
-                           sym pos (mpi->path* modidx) tl meta res))
-        res])]))
-
-(define (filter-rewritable-module-variable? name new-#f-idx toplevel-offset mod-toplevels)
-  (define-values
-    (i new-toplevels remap)
-    (for/fold ([i 0]
-               [new-toplevels empty]
-               [remap empty])
-              ([tl (in-list mod-toplevels)]
-               [idx (in-naturals)])
-      (log-debug (format "[~S] mod-prefix tls\t~v ~v"
-                         name idx tl))
-      (match tl
-        [(and mv (struct module-variable (modidx sym pos phase constantness)))
-         (define rw ((current-get-modvar-rewrite) modidx))
-         ;; XXX We probably don't need to deal with #f phase
-         (unless (or (not phase) (zero? phase))
-           (error 'eliminate-module-variables "Non-zero phases not supported: ~S" mv))
-         (cond
-           ; Primitive module like #%paramz
-           [(symbol? rw)
-            (log-debug (format "~S from ~S" sym rw))
-            (values (add1 i)
-                    (list* tl new-toplevels)
-                    (list* (+ i toplevel-offset) remap))]
-           [(module-path-index? rw)
-            (values (add1 i)
-                    (list* tl new-toplevels)
-                    (list* (+ i toplevel-offset) remap))]
-           [(modvar-rewrite? rw)
-            (values i
-                    new-toplevels
-                    (list* (compute-new-modvar mv rw) remap))]
-           [else
-            (error 'filter-rewritable-module-variable? "Unsupported module-rewrite: ~S" rw)])]
-        [tl
-         (cond
-           [(and new-#f-idx (not tl))
-            (log-debug (format "[~S] dropping a #f at ~v that would have been at ~v but is now at ~v"
-                               name idx (+ i toplevel-offset) new-#f-idx))
-            (values i
-                    new-toplevels
-                    (list* new-#f-idx remap))]
-           [else
-            (values (add1 i)
-                    (list* tl new-toplevels)
-                    (list* (+ i toplevel-offset) remap))])])))
-  ; XXX This would be more efficient as a vector
-  (values (reverse new-toplevels)
-          (reverse remap)))
-
-(define (merge-module max-let-depth top-prefix mod-form)
-  (match mod-form
-    [(struct mod (name srcname self-modidx
-                       mod-prefix provides requires body syntax-bodies
-                       unexported mod-max-let-depth dummy lang-info
-                       internal-context binding-names
-                       flags pre-submodules post-submodules))
-     (define top-toplevels (prefix-toplevels top-prefix))
-     (define toplevel-offset (length top-toplevels))
-     (define topsyntax-offset (length (prefix-stxs top-prefix)))
-     (define lift-offset (prefix-num-lifts top-prefix))
-     (define mod-toplevels (prefix-toplevels mod-prefix))
-     (define new-#f-idx
-       (index-of #f top-toplevels))
-     (when new-#f-idx
-       (log-debug (format "[~S] found a #f entry in prefix already at ~v, squashing"
-                          name new-#f-idx)))
-     (define-values (new-mod-toplevels toplevel-remap)
-       (filter-rewritable-module-variable? name new-#f-idx toplevel-offset mod-toplevels))
-     (define num-mod-toplevels
-       (length toplevel-remap))
-     (define mod-stxs
-       (length (prefix-stxs mod-prefix)))
-     (define mod-num-lifts
-       (prefix-num-lifts mod-prefix))
-     (define new-mod-prefix
-       (struct-copy prefix mod-prefix
-                    [toplevels new-mod-toplevels]))
-     (define offset-meta (vector name srcname self-modidx))
-     (log-debug "Setting toplevel offsets rewriter for ~S and it is currently ~S"
-                offset-meta
-                (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx #f))
-     (hash-set! MODULE-TOPLEVEL-OFFSETS self-modidx
-                (toplevel-offset-rewriter
-                 (lambda (n)
-                   (log-debug "Finding offset ~a in ~S of ~S" n toplevel-remap offset-meta)
-                   (list-ref toplevel-remap n))
-                 offset-meta))
-     (unless (= (length toplevel-remap)
-                (length mod-toplevels))
-       (error 'merge-module "Not remapping everything: ~S ~S"
-              mod-toplevels toplevel-remap))
-     (log-debug (format "[~S] Incrementing toplevels by ~a"
-                        name
-                        toplevel-offset))
-     (log-debug (format "[~S] Incrementing lifts by ~a"
-                        name
-                        lift-offset))
-     (log-debug (format "[~S] Filtered mod-vars from ~a to ~a"
-                        name
-                        (length mod-toplevels)
-                        (length new-mod-toplevels)))
-     (values (max max-let-depth mod-max-let-depth)
-             (merge-prefix top-prefix new-mod-prefix)
-             (lambda (top-prefix)
-               (log-debug (format "[~S] Updating top-levels" name))
-               (define top-lift-start (prefix-lift-start top-prefix))
-               (define mod-lift-start (prefix-lift-start mod-prefix))
-               (define total-lifts (prefix-num-lifts top-prefix))
-               (define max-toplevel (+ top-lift-start total-lifts))
-               (define update
-                 (update-toplevels
-                  (lambda (n)
-                    (define new-idx
-                      (cond
-                        [(mod-lift-start . <= . n)
-                         (log-debug (format "[~S] ~v is a lift"
-                                            name n))
-                         (define which-lift (- n mod-lift-start))
-                         (define lift-tl (+ top-lift-start lift-offset which-lift))
-                         (when (lift-tl . >= . max-toplevel)
-                           (error 'merge-module "[~S] lift error: orig(~a) which(~a) max(~a) lifts(~a) now(~a)"
-                                  name n which-lift num-mod-toplevels mod-num-lifts lift-tl))
-                         lift-tl]
-                        [else
-                         ;; xxx maybe change this to a vector after it is made to make this efficient
-                         (list-ref toplevel-remap n)]))
-                    (log-debug (format "[~S] ~v is remapped to ~v"
-                                       name n new-idx))
-                    new-idx)
-                  (lambda (n)
-                    (+ n topsyntax-offset))
-                  (prefix-syntax-start top-prefix)))
-               (map update body)))]))
-
-(provide/contract
- [merge-compilation-top (-> get-modvar-rewrite/c
-                            compilation-top?
-                            compilation-top?)])

pkgs/compiler-lib/compiler/demodularizer/module.rkt

@@ -1,43 +0,0 @@
-#lang racket/base
-
-(require racket/list
-         racket/match
-         racket/contract
-         compiler/zo-parse
-         "util.rkt")
-
-(define (->module-path-index s)
-  (if (module-path-index? s)
-      s
-      (module-path-index-join `(quote ,s) #f)))
-
-(define (wrap-in-kernel-module name srcname lang-info self-modidx top)
-  (match top
-    [(struct compilation-top (max-let-depth binding-namess prefix form))
-     (define-values (reqs new-forms)
-       (partition req? (splice-forms form)))
-     (define requires
-       (map (compose ->module-path-index stx-obj-datum stx-content req-reqs) reqs))
-     (make-compilation-top 
-      0
-      #hash()
-      (make-prefix 0 (list #f) empty (prefix-src-inspector-desc prefix))
-      (make-mod name srcname
-                self-modidx
-                prefix
-                empty ; provides
-                (list (cons 0 requires))
-                new-forms
-                empty ; syntax-body
-                (list) ; unexported
-                max-let-depth
-                (make-toplevel 0 0 #f #f) ; dummy
-                lang-info
-                #t
-                (hash) ; no names visible via `module->namespace`
-                empty
-                empty
-                empty))]))
-
-(provide/contract
- [wrap-in-kernel-module (symbol? symbol? lang-info/c module-path-index? compilation-top? . -> . compilation-top?)])

pkgs/compiler-lib/compiler/demodularizer/mpi.rkt

@@ -1,41 +0,0 @@
-#lang racket/base
-
-(require racket/contract
-         syntax/modresolve)
-
-(define current-module-path (make-parameter #f))
-
-(define (mpi->string modidx)
-  (cond
-    [(symbol? modidx) modidx]
-    [else 
-     (mpi->path! modidx)]))
-
-(define MODULE-PATHS (make-parameter #f))
-(define (mpi->path! mpi)
-  (hash-ref! 
-   (MODULE-PATHS) mpi 
-   (lambda ()
-     (define _pth
-       (resolve-module-path-index mpi (current-module-path)))
-     (cond
-      [(path? _pth) (simplify-path _pth #t)]
-      [(and (pair? _pth)
-            (path? (cadr _pth)))
-       (list* 'submod (simplify-path (cadr _pth) #t) (cddr _pth))]
-      [else _pth]))))
-(define (mpi->path* mpi)
-  (hash-ref (MODULE-PATHS) mpi 
-            (lambda ()
-              (error 'mpi->path* "Cannot locate cache of path for ~S" mpi))))
-
-(define submod-path/c
-  (cons/c 'submod
-          (cons/c (or/c symbol? path?)
-                  (listof symbol?))))
-
-(provide/contract
- [MODULE-PATHS (parameter/c (or/c false/c hash?))]
- [current-module-path (parameter/c (or/c path-string? submod-path/c))]
- [mpi->path! (module-path-index? . -> . (or/c symbol? path? submod-path/c))]
- [mpi->path* (module-path-index? . -> . (or/c symbol? path? pair? submod-path/c))])

pkgs/compiler-lib/compiler/demodularizer/nodep.rkt

@@ -1,228 +0,0 @@
-#lang racket/base
-
-(require racket/list
-         racket/match
-         racket/contract
-         compiler/zo-parse
-         "util.rkt"
-         "mpi.rkt"
-         racket/set)
-
-(define current-excluded-modules (make-parameter (set)))
-
-(define ZOS (make-parameter #f))
-(define MODULE-IDX-MAP (make-parameter #f))
-(define PHASE*MODULE-CACHE (make-parameter #f))
-
-(define (nodep-file file-to-batch)
-  (define idx-map (make-hash))
-  (parameterize ([ZOS (make-hash)]
-                 [MODULE-IDX-MAP idx-map]
-                 [PHASE*MODULE-CACHE (make-hasheq)])
-    (define (get-modvar-rewrite modidx)
-      (define pth (mpi->path* modidx))
-      (hash-ref idx-map pth
-                (lambda ()
-                  (error 'get-modvar-rewrite "Cannot locate modvar rewrite for ~S" pth))))
-    (match (get-nodep-module-code/path file-to-batch 0)
-      [(struct @phase (_ (struct module-code (modvar-rewrite lang-info ctop))))
-       (values ctop lang-info (modvar-rewrite-modidx modvar-rewrite) get-modvar-rewrite)])))
-
-(define (path->comp-top pth submod)
-  (hash-ref! (ZOS) (cons pth submod)
-             (λ ()
-                (define zo (call-with-input-file pth zo-parse))
-                (if submod
-                    (extract-submod zo submod)
-                    zo))))
-
-(define (extract-submod zo submod)
-  (define m (compilation-top-code zo))
-  (struct-copy compilation-top
-               zo
-               [code (let loop ([m m])
-                       (if (and (pair? (mod-name m))
-                                (equal? submod (cdr (mod-name m))))
-                           m
-                           (or (ormap loop (mod-pre-submodules m))
-                               (ormap loop (mod-post-submodules m)))))]))
-
-(define (excluded? pth)
-  (and (path? pth)
-       (set-member? (current-excluded-modules) (path->string pth))))
-
-(define (get-nodep-module-code/index mpi phase)
-  (define pth (mpi->path! mpi))
-  (cond
-    [(symbol? pth)
-     (hash-set! (MODULE-IDX-MAP) pth pth)
-     pth]
-    [(excluded? pth)
-     (hash-set! (MODULE-IDX-MAP) pth mpi)
-     mpi]
-    [else
-     (get-nodep-module-code/path pth phase)]))
-
-(define-struct @phase (phase code))
-(define-struct modvar-rewrite (modidx provide->toplevel))
-(define-struct module-code (modvar-rewrite lang-info ctop))
-(define @phase-ctop (compose module-code-ctop @phase-code))
-
-(define (get-nodep-module-code/path pth phase)
-  (define MODULE-CACHE
-    (hash-ref! (PHASE*MODULE-CACHE) phase make-hash))
-  (if (hash-ref MODULE-CACHE pth #f)
-      #f
-      (hash-ref! 
-       MODULE-CACHE pth 
-       (lambda ()
-         (define-values (base file dir?) (split-path (if (path-string? pth)
-                                                         pth
-                                                         (cadr pth))))
-         (define base-directory
-           (if (path? base) 
-               (path->complete-path base (current-directory))
-               (current-directory)))
-         (define-values (modvar-rewrite lang-info ctop)
-           (begin
-             (log-debug (format "Load ~S @ ~S" pth phase))
-             (nodep/dir
-              (parameterize ([current-load-relative-directory base-directory])
-                (path->comp-top
-                 (build-compiled-path 
-                  base 
-                  (path-add-suffix file #".zo"))
-                 (and (pair? pth) (cddr pth))))
-              pth
-              phase)))
-         (when (and phase (zero? phase))
-           (hash-set! (MODULE-IDX-MAP) pth modvar-rewrite))
-         (make-@phase 
-          phase
-          (make-module-code modvar-rewrite lang-info ctop))))))
-
-(define (nodep/dir top pth phase)
-  (define pth*
-    (cond 
-      [(string? pth) (string->path pth)]
-      [(list? pth) (cadr pth)]
-      [else pth]))
-  (parameterize ([current-module-path pth*])
-    (nodep top phase)))
-
-(define (nodep top phase)
-  (match top
-    [(struct compilation-top (max-let-depth binding-namess prefix form))
-     (define-values (modvar-rewrite lang-info new-form) (nodep-form form phase))
-     (values modvar-rewrite lang-info (make-compilation-top max-let-depth #hash() prefix new-form))]
-    [else (error 'nodep "unrecognized: ~e" top)]))
-
-(define (nodep-form form phase)
-  (if (mod? form)
-      (let-values ([(modvar-rewrite lang-info mods)
-                    (nodep-module form phase)])
-        (values modvar-rewrite lang-info (make-splice mods)))
-      (error 'nodep-form "Doesn't support non mod forms")))
-
-; XXX interning is hack to fix test/add04.ss and provide/contract renaming
-(define (intern s) (string->symbol (symbol->string s)))
-(define (construct-provide->toplevel prefix provides)
-  (define provide-ht (make-hasheq))
-  (for ([tl (prefix-toplevels prefix)]
-        [i (in-naturals)])
-      (when (symbol? tl)
-        (hash-set! provide-ht (intern tl) i)))  
-  (lambda (sym pos)
-    (define isym (intern sym))
-    (log-debug (format "Looking up ~S@~a [~S] in ~S" sym pos isym prefix))
-    (define res
-      (hash-ref provide-ht isym
-              (lambda ()
-                (error 'provide->toplevel "Cannot find ~S in ~S" sym prefix))))
-    (log-debug (format "Looked up ~S@~a and got ~v" sym pos res))
-    res))
-
-(define (nodep-module mod-form phase)
-  (match mod-form
-    [(struct mod (name srcname self-modidx
-                       prefix provides requires body syntax-bodies
-                       unexported max-let-depth dummy lang-info
-                       internal-context binding-names
-                       flags pre-submodules post-submodules))
-     (define new-prefix prefix)
-     ;; Cache all the mpi paths
-     (for-each (match-lambda
-                 [(and mv (struct module-variable (modidx sym pos phase constantness)))
-                  (mpi->path! modidx)]
-                 [tl
-                  (void)])
-               (prefix-toplevels new-prefix))
-     (define mvs (filter module-variable? (prefix-toplevels new-prefix)))
-     (log-debug (format "[~S] module-variables: ~S - ~S" name (length mvs) mvs))
-     (values (make-modvar-rewrite self-modidx (construct-provide->toplevel new-prefix provides))
-             lang-info
-             (append (requires->modlist requires phase)
-                     (if (and phase (zero? phase))
-                         (begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now
-                                (list (make-mod name srcname self-modidx
-                                                new-prefix provides requires body empty
-                                                unexported max-let-depth dummy lang-info internal-context #hash()
-                                                empty empty empty)))
-                         (begin (log-debug (format "[~S] Dropping module @ ~S" name phase))
-                                empty))))]              
-    [else (error 'nodep-module "huh?: ~e" mod-form)]))
-
-(define (+* l r)
-  (if (and l r) (+ l r) #f))
-
-(define (requires->modlist requires current-phase)
-  (apply append
-         (map
-          (match-lambda
-            [(list-rest req-phase mpis)
-             (define phase (+* current-phase req-phase))
-             (apply append
-                    (map (compose extract-modules (lambda (mpi) (get-nodep-module-code/index mpi phase))) mpis))])
-          requires)))
-
-(define (all-but-last l)
-  (reverse (rest (reverse l))))
-
-(define REQUIRED (make-hasheq))
-(define (extract-modules ct)
-  (cond
-    [(compilation-top? ct)
-     (match (compilation-top-code ct)
-       [(and m (? mod?))
-        (list m)]
-       [(struct splice (mods))
-        mods])]
-    [(symbol? ct)
-     (if (hash-has-key? REQUIRED ct)
-         empty
-         (begin
-           (hash-set! REQUIRED ct #t)
-           (list (make-req (make-stx (make-stx-obj ct (wrap empty empty empty) #f #hasheq() 'clean)) (make-toplevel 0 0 #f #f)))))]
-    [(module-path-index? ct)
-     (if (hash-has-key? REQUIRED ct)
-         empty
-         (begin
-           (hash-set! REQUIRED ct #t)
-           (list (make-req (make-stx (make-stx-obj ct (wrap empty empty empty) #f #hasheq() 'clean)) (make-toplevel 0 0 #f #f)))))]
-    [(not ct)
-     empty]
-    [(@phase? ct)
-     (extract-modules (@phase-ctop ct))]
-    [else
-     (error 'extract-modules "Unknown extraction: ~S" ct)]))
-
-(define get-modvar-rewrite/c 
-  (module-path-index? . -> . (or/c symbol? modvar-rewrite? module-path-index?)))
-(provide/contract
- [struct modvar-rewrite 
-         ([modidx module-path-index?]
-          [provide->toplevel (symbol? exact-nonnegative-integer? . -> . exact-nonnegative-integer?)])]
- [get-modvar-rewrite/c contract?]
- [current-excluded-modules (parameter/c generic-set?)]
- [nodep-file (-> path-string?
-                 (values compilation-top? lang-info/c module-path-index? get-modvar-rewrite/c))])

pkgs/compiler-lib/compiler/demodularizer/replace-modidx.rkt

@@ -1,29 +0,0 @@
-#lang racket/base
-
-(require racket/match
-         racket/vector
-         racket/struct
-         "util.rkt")
-
-(provide replace-modidx)
-
-(define (replace-modidx expr self-modidx)
-  (define (inner-update e)
-      (match e
-        [(app prefab-struct-key (and key (not #f))) 
-         (apply make-prefab-struct key 
-                (map update
-                     (struct->list e)))]
-        [(? module-path-index?) 
-         (define-values (path mpi) (module-path-index-split e))
-         (if (not path)
-             self-modidx
-             (module-path-index-join path (update mpi)))]
-        [(cons a b)
-         (cons (update a) (update b))]
-        [(? vector?)
-         (vector-map update e)]
-        [else e]))
-  (define-values (first-update update)
-    (build-form-memo inner-update))
-  (first-update expr))

pkgs/compiler-lib/compiler/demodularizer/update-toplevels.rkt

@@ -1,108 +0,0 @@
-#lang racket/base
-
-(require racket/match
-         racket/contract
-         compiler/zo-structs
-         "util.rkt")
-
-(define (update-toplevels toplevel-updater topsyntax-updater topsyntax-new-midpt)
-  (define (inner-update form)
-    (match form
-      [(struct def-values (ids rhs))
-       (make-def-values (map update ids)
-                        (update rhs))]
-      [(? def-syntaxes?)
-       (error 'increment "Doesn't handle syntax")]
-      [(? seq-for-syntax?)
-       (error 'increment "Doesn't handle syntax")]
-      [(struct inline-variant (direct inline))
-       (update direct)]
-      [(struct req (reqs dummy))
-       (make-req reqs (update dummy))]
-      [(? mod?)
-       (error 'increment "Doesn't handle modules")]
-      [(struct seq (forms))
-       (make-seq (map update forms))]
-      [(struct splice (forms))
-       (make-splice (map update forms))]
-      [(and l (struct lam (name flags num-params param-types rest? closure-map closure-types tl-map max-let-depth body)))
-       (struct-copy lam l
-                    [toplevel-map #f] ; conservative
-                    [body (update body)])]
-      [(and c (struct closure (code gen-id)))
-       (struct-copy closure c
-                    [code (update code)])]
-      [(and cl (struct case-lam (name clauses)))
-       (define new-clauses
-         (map update clauses))
-       (struct-copy case-lam cl
-                    [clauses new-clauses])]
-      [(struct let-one (rhs body type unused?))
-       (make-let-one (update rhs) (update body) type unused?)]
-      [(and f (struct let-void (count boxes? body)))
-       (struct-copy let-void f
-                    [body (update body)])]
-      [(and f (struct install-value (_ _ _ rhs body)))
-       (struct-copy install-value f
-                    [rhs (update rhs)]
-                    [body (update body)])]
-      [(struct let-rec (procs body))
-       (make-let-rec (map update procs) (update body))]
-      [(and f (struct boxenv (_ body)))
-       (struct-copy boxenv f [body (update body)])]
-      [(and f (struct toplevel (_ pos _ _)))
-       (struct-copy toplevel f
-                    [pos (toplevel-updater pos)])]
-      [(and f (struct topsyntax (_ pos _)))
-       (struct-copy topsyntax f
-                    [pos (topsyntax-updater pos)]
-                    [midpt topsyntax-new-midpt])]
-      [(struct application (rator rands))
-       (make-application 
-        (update rator)
-        (map update rands))]
-      [(struct branch (test then else))
-       (make-branch 
-        (update test)
-        (update then)
-        (update else))]
-      [(struct with-cont-mark (key val body))
-       (make-with-cont-mark 
-        (update key)
-        (update val)
-        (update body))]
-      [(struct with-immed-mark (key val body))
-       (make-with-immed-mark 
-        (update key)
-        (update val)
-        (update body))]
-      [(struct beg0 (seq))
-       (make-beg0 (map update seq))]
-      [(struct varref (tl dummy))
-       (make-varref (update tl) (update dummy))]
-      [(and f (struct assign (id rhs undef-ok?)))
-       (struct-copy assign f
-                    [id (update id)]
-                    [rhs (update rhs)])]
-      [(struct apply-values (proc args-expr))
-       (make-apply-values
-        (update proc)
-        (update args-expr))]
-      [(and f (struct primval (id)))
-       f]
-      [(and f (struct localref (unbox? pos clear? other-clears? type)))
-       f]
-      [(and f (not (? form?)))
-       f]
-      ))
-  (define-values (first-update update)
-    (build-form-memo inner-update))
-  first-update)
-
-(provide/contract
- [update-toplevels 
-  ((exact-nonnegative-integer? . -> . exact-nonnegative-integer?)
-   (exact-nonnegative-integer? . -> . exact-nonnegative-integer?)
-   exact-nonnegative-integer?
-   . -> .
-   (form? . -> . form?))])

pkgs/compiler-lib/compiler/demodularizer/util.rkt

@@ -1,79 +0,0 @@
-#lang racket/base
-
-(require racket/contract
-         compiler/zo-parse)
-
-(define (prefix-syntax-start pre)
-  (length (prefix-toplevels pre)))
-
-(define (prefix-lift-start pre)
-  (define syntax-start (prefix-syntax-start pre))
-  (define total-stxs (length (prefix-stxs pre)))
-  (+ syntax-start total-stxs (if (zero? total-stxs) 0 1)))
-
-(struct nothing ())
-
-(define-syntax-rule (eprintf* . args) (void))
-
-(define (build-form-memo inner-update #:void? [void? #f])
-  (define memo (make-hasheq))
-  (define (update form . args)
-    (eprintf* "Updating on ~a\n" form)
-    (define fin
-      (cond
-        [(hash-ref memo form #f) 
-         => (λ (x)
-              (eprintf* "Found in memo table\n")
-              x)]
-        [else
-         (eprintf* "Not in memo table\n")
-         (let ()
-           (define ph (make-placeholder (nothing)))
-           (hash-set! memo form ph)
-           (define nv (nothing))
-           (dynamic-wind void
-                         (λ ()
-                           (set! nv (apply inner-update form args)))
-                         (λ ()
-                           (if (nothing? nv)
-                               (eprintf* "inner-update returned nothing (or there was an escape) on ~a\n" form)
-                               (begin
-                                 (placeholder-set! ph nv)
-                                 (hash-set! memo form nv)))))
-           nv)]))
-    (eprintf* "Updating on ~a ---->\n ~a\n" form fin)
-    fin)
-  (define (first-update form . args)
-    (eprintf* "Top level update on ~a\n" form)
-    (define final (apply update form args))
-    (eprintf* "Top level update on ~a ---->\n ~a\n" form final)
-    (define fin (make-reader-graph final))
-    (eprintf* "Top level update on ~a ---->\n ~a [after reader-graph]\n" form fin)
-    fin)
-  (values first-update update))
-
-(define lang-info/c
-  (or/c #f (vector/c module-path? symbol? any/c)))
-
-
-(define (build-compiled-path base name)
-  (build-path 
-   (cond [(path? base) base]
-	 [(eq? base 'relative) 'same]
-	 [(eq? base #f) (error 'batch "Impossible")])
-   "compiled"
-   name))
-
-
-(provide/contract
- [prefix-syntax-start (prefix? . -> . exact-nonnegative-integer?)]
- [prefix-lift-start (prefix? . -> . exact-nonnegative-integer?)]
- [eprintf ((string?) () #:rest (listof any/c) . ->* . void)]
- [build-form-memo 
-  (((unconstrained-domain-> any/c))
-   (#:void? boolean?)
-   . ->* .
-   (values (unconstrained-domain-> any/c)
-           (unconstrained-domain-> any/c)))]
- [lang-info/c contract?]
- [build-compiled-path ((or/c path-string? (symbols 'relative) false/c) path-string? . -> . (or/c path-string? (symbols 'same 'up)))])

pkgs/compiler-lib/compiler/embed-sig.rkt

@@ -1,13 +0,0 @@
-
-(module embed-sig racket/base
-  (require racket/unit)
-  (provide compiler:embed^)
-
-  (define-signature compiler:embed^
-    (create-embedding-executable
-     make-embedding-executable
-     write-module-bundle
-     embedding-executable-is-directory?
-     embedding-executable-is-actually-directory?
-     embedding-executable-put-file-extension+style+filters
-     embedding-executable-add-suffix)))

pkgs/compiler-lib/compiler/embed-unit.rkt

@@ -1,9 +0,0 @@
-#lang racket/base
-(require racket/unit
-         racket/contract
-	 "sig.rkt"
-	 compiler/embed 
-	 "embed-sig.rkt")
-
-(define-unit-from-context compiler:embed@ compiler:embed^)
-(provide compiler:embed@)

pkgs/compiler-lib/compiler/option-unit.rkt

@@ -1,7 +0,0 @@
-#lang racket/base
-
-(require racket/unit compiler/sig compiler/option)
-
-(provide compiler:option@)
-
-(define-unit-from-context compiler:option@ compiler:option^)

pkgs/compiler-lib/compiler/sig.rkt

@@ -1,39 +0,0 @@
-#lang racket/base
-
-(require racket/unit)
-
-(provide compiler:option^
-         compiler^)
-
-;; Compiler options
-(define-signature compiler:option^
-  (somewhat-verbose ; default = #f
-   verbose ; default = #f
-   
-
-   setup-prefix ; string to embed in public names;
-                ; used mainly for compiling extensions
-                ;  with the collection name so that 
-                ;  cross-extension conflicts are less
-                ;  likely in architectures that expose
-                ;  the public names of loaded extensions
-                ; default = ""
-
-   3m ; #t => build for 3m
-      ; default = #f
-
-   compile-subcollections   ; #t => compile collection subdirectories
-                            ; default = #t
-
-   ))
-
-;; Compiler procedures
-(define-signature compiler^
-  (compile-zos
-
-   compile-collection-zos
-   compile-directory-zos
-   compile-directory-srcs
-
-   current-compiler-dynamic-require-wrapper
-   compile-notify-handler))

pkgs/compiler-lib/info.rkt

@@ -1,16 +0,0 @@
-#lang info
-
-(define collection 'multi)
-
-(define deps '(["base" #:version "6.5.0.2"]
-               "scheme-lib"
-               "rackunit-lib"
-               "zo-lib"))
-
-(define implies '("zo-lib"))
-
-(define pkg-desc "implementation (no documentation) part of \"compiler\"")
-
-(define pkg-authors '(mflatt))
-
-(define version "1.4")

pkgs/compiler-lib/launcher/launcher-sig.rkt

@@ -1,57 +0,0 @@
-#lang racket/signature
-
-make-gracket-launcher
-make-racket-launcher
-make-mred-launcher
-make-mzscheme-launcher
-
-make-gracket-program-launcher
-make-racket-program-launcher
-make-mred-program-launcher
-make-mzscheme-program-launcher
-
-gracket-program-launcher-path
-racket-program-launcher-path
-mred-program-launcher-path
-mzscheme-program-launcher-path
-
-install-gracket-program-launcher
-install-racket-program-launcher
-install-mred-program-launcher
-install-mzscheme-program-launcher
-
-gracket-launcher-up-to-date?
-racket-launcher-up-to-date?
-mred-launcher-up-to-date?
-mzscheme-launcher-up-to-date?
-
-gracket-launcher-is-directory?
-racket-launcher-is-directory?
-mred-launcher-is-directory?
-mzscheme-launcher-is-directory?
-
-gracket-launcher-is-actually-directory?
-racket-launcher-is-actually-directory?
-mred-launcher-is-actually-directory?
-mzscheme-launcher-is-actually-directory?
-
-gracket-launcher-add-suffix
-racket-launcher-add-suffix
-mred-launcher-add-suffix
-mzscheme-launcher-add-suffix
-
-gracket-launcher-put-file-extension+style+filters
-racket-launcher-put-file-extension+style+filters
-mred-launcher-put-file-extension+style+filters
-mzscheme-launcher-put-file-extension+style+filters
-
-build-aux-from-path
-extract-aux-from-path
-current-launcher-variant
-available-mred-variants
-available-mzscheme-variants
-available-gracket-variants
-available-racket-variants
-
-installed-executable-path->desktop-path
-installed-desktop-path->icon-path

pkgs/compiler-lib/launcher/launcher-unit.rkt

@@ -1,7 +0,0 @@
-#lang racket/base
-
-(require racket/unit "launcher-sig.rkt" launcher/launcher)
-
-(provide launcher@)
-
-(define-unit-from-context launcher@ launcher^)

pkgs/compiler-lib/setup/option-sig.rkt

@@ -1,37 +0,0 @@
-(module option-sig racket/base
-  (require racket/unit)
-  
-  (provide setup-option^)
-
-  (define-signature setup-option^
-    (setup-program-name
-     verbose
-     make-verbose
-     compiler-verbose
-     clean
-     compile-mode
-     make-only
-     make-zo
-     make-info-domain
-     make-foreign-libs
-     make-launchers
-     make-docs
-     make-user
-     make-planet
-     avoid-main-installation
-     make-tidy
-     make-doc-index
-     check-dependencies
-     fix-dependencies
-     call-install
-     call-post-install
-     pause-on-errors
-     parallel-workers
-     force-unpacks
-     doc-pdf-dest
-     specific-collections
-     specific-planet-dirs
-     archives
-     archive-implies-reindex
-     current-target-directory-getter
-     current-target-plt-directory-getter)))

pkgs/compiler-lib/setup/option-unit.rkt

@@ -1,6 +0,0 @@
-#lang racket/base
-(require racket/unit setup/option "option-sig.rkt")
-
-(provide setup:option@ set-flag-params)
-
-(define-unit-from-context setup:option@ setup-option^)

pkgs/compiler-lib/setup/setup-unit.rkt

@@ -1,9 +0,0 @@
-#lang racket/base
-
-(require racket/unit setup/setup-core)
-
-(provide setup@)
-(define-unit setup@
-  (import)
-  (export)
-  (setup-core))

pkgs/compiler-test/LICENSE.txt

@@ -1,11 +0,0 @@
-compiler-test
-Copyright (c) 2010-2017 PLT Design Inc.
-
-This package is distributed under the GNU Lesser General Public
-License (LGPL).  This means that you can link this package into proprietary
-applications, provided you follow the rules stated in the LGPL.  You
-can also modify this package; if you distribute a modified version,
-you must distribute it under the terms of the LGPL, which in
-particular means that you must release the source code for the
-modified software.  See http://www.gnu.org/copyleft/lesser.html
-for more information.

pkgs/compiler-test/info.rkt

@@ -1,20 +0,0 @@
-#lang info
-
-(define collection 'multi)
-
-(define deps '("base"))
-
-(define pkg-desc "tests for \"compiler-lib\"")
-
-(define pkg-authors '(mflatt))
-(define build-deps '("compiler-lib"
-                     "eli-tester"
-                     "rackunit-lib"
-                     "net-lib"
-                     "scheme-lib"
-                     "compatibility-lib"
-                     "gui-lib"
-                     "htdp-lib"
-                     "plai-lib"
-                     "rackunit-lib"))
-(define update-implies '("compiler-lib"))

pkgs/compiler-test/tests/compiler/collection-zos.rkt

@@ -1,5 +0,0 @@
-#lang racket
-(require compiler/compiler)
-
-;; minimal sanity check:
-(compile-collection-zos "setup")

pkgs/compiler-test/tests/compiler/commands/test.rkt

@@ -1,5 +0,0 @@
-#lang racket
-(require rackunit)
-(require (only-in (submod compiler/commands/test paths) collection-paths))
-
-(check-exn exn? (lambda () (collection-paths ".")))

pkgs/compiler-test/tests/compiler/ctool.rkt

@@ -1,19 +0,0 @@
-#lang racket
-(require setup/dirs)
-
-(define raco (build-path (find-console-bin-dir)
-                         (if (eq? (system-type) 'windows)
-                             "raco.exe"
-                             "raco")))
-
-(define tmp (make-temporary-file))
-
-(system* raco
-         "ctool"
-         "--3m"
-         "--c-mods"
-         tmp
-         "++lib"
-         "racket")
-
-(delete-file tmp)

pkgs/compiler-test/tests/compiler/demodularizer/demod-test.rkt

@@ -1,53 +0,0 @@
-#lang racket
-(require tests/eli-tester
-         racket/runtime-path
-         compiler/find-exe)
-
-(define (capture-output command . args)
-  (define o (open-output-string))
-  (define e (open-output-string))
-  (parameterize ([current-input-port (open-input-string "")]
-                 [current-output-port o]
-                 [current-error-port e])
-    (apply system* command args))
-  (values (get-output-string o) (get-output-string e)))
-
-(define (test-on-program filename)
-  ;; run modular program, capture output
-  (define-values (modular-output modular-error)
-    (capture-output (find-exe) filename))
-  
-  (define demod-filename 
-    (let-values ([(base filename dir?) (split-path filename)])
-      (path->string
-       (build-path
-        (find-system-path 'temp-dir)
-        (path-add-suffix filename #"_merged.zo")))))
-  
-  ;; demodularize
-  (parameterize ([current-input-port (open-input-string "")])
-    (system* (find-exe) "-l-" "raco" "demod" "-o" demod-filename filename))
-  
-  ;; run whole program
-  (define-values (whole-output whole-error)
-    (capture-output (find-exe) demod-filename))
-  
-  ;; compare output 
-  (test
-   #:failure-prefix (format "~a stdout" filename)
-   whole-output => modular-output
-   #:failure-prefix (format "~a stderr" filename)
-   whole-error => modular-error))
-
-(define-runtime-path tests "tests")
-
-(define (modular-program? filename)
-  (and (not (regexp-match #rx"merged" filename))
-       (regexp-match #rx"rkt$" filename)))
-
-(test
- (for ([i (in-list (directory-list tests))])
-   (define ip (build-path tests i))
-   (when (modular-program? ip)
-     (printf "Checking ~a\n" ip)
-     (test-on-program (path->string ip)))))

pkgs/compiler-test/tests/compiler/demodularizer/info.rkt

@@ -1,3 +0,0 @@
-#lang info
-
-(define test-timeouts '(("demod-test.rkt" 300)))

pkgs/compiler-test/tests/compiler/demodularizer/tests/base-5.rkt

@@ -1,2 +0,0 @@
-#lang racket/base
-5

pkgs/compiler-test/tests/compiler/demodularizer/tests/kernel-5.rkt

@@ -1,5 +0,0 @@
-(module kernel-5 '#%kernel
-  (#%require racket/private/map)
-  (define-values (id) (λ (x) x))
-  (define-values (xs) (list 1 2 3 4 5))
-  (map id (map id xs)))

pkgs/compiler-test/tests/compiler/demodularizer/tests/racket-5.rkt

@@ -1,2 +0,0 @@
-#lang racket
-5

pkgs/compiler-test/tests/compiler/embed/embed-asl.rkt

@@ -1,4 +0,0 @@
-;; The first three lines of this file were inserted by DrRacket. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-advanced-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
-10

pkgs/compiler-test/tests/compiler/embed/embed-bsl.rkt

@@ -1,4 +0,0 @@
-;; The first three lines of this file were inserted by DrRacket. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-beginner-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
-10

pkgs/compiler-test/tests/compiler/embed/embed-bsla.rkt

@@ -1,4 +0,0 @@
-;; The first three lines of this file were inserted by DrRacket. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
-10

pkgs/compiler-test/tests/compiler/embed/embed-isl.rkt

@@ -1,4 +0,0 @@
-;; The first three lines of this file were inserted by DrRacket. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-intermediate-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
-10

pkgs/compiler-test/tests/compiler/embed/embed-isll.rkt

@@ -1,4 +0,0 @@
-;; The first three lines of this file were inserted by DrRacket. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
-10

pkgs/compiler-test/tests/compiler/embed/embed-me1.rkt

@@ -1,5 +0,0 @@
-(module embed-me1 mzscheme
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "This is 1\n"))
-    'append))
-

pkgs/compiler-test/tests/compiler/embed/embed-me10.rkt

@@ -1,9 +0,0 @@
-(module embed-me10 mzscheme
-  (require openssl/mzssl)
-
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () 
-      (printf "~a\n" ssl-available?))
-    'append))
-
-

pkgs/compiler-test/tests/compiler/embed/embed-me11-rd.rkt

@@ -1,15 +0,0 @@
-(module embed-me11-rd mzscheme
-  (provide (rename *read-syntax read-syntax)
-           (rename *read read))
-
-  (define (*read port)
-    `(module embed-me11 mzscheme
-       (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-         (lambda () 
-           (printf ,(read port) 
-                   ;; Use `getenv' at read time!!!
-                   ,(getenv "ELEVEN")))
-         'append)))
-
-  (define (*read-syntax src port)
-    (*read port)))

pkgs/compiler-test/tests/compiler/embed/embed-me11.rkt

@@ -1,2 +0,0 @@
-#reader(lib "embed-me11-rd.ss" "tests" "compiler" "embed")
-"It goes to ~a!\n"

pkgs/compiler-test/tests/compiler/embed/embed-me12-rd.ss

@@ -1,15 +0,0 @@
-(module embed-me11-rd mzscheme
-  (provide (rename *read-syntax read-syntax)
-           (rename *read read))
-
-  (define (*read port)
-    `(module embed-me11 mzscheme
-       (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-         (lambda () 
-           (printf ,(read port) 
-                   ;; Use `getenv' at read time!!!
-                   ,(getenv "ELEVEN")))
-         'append)))
-
-  (define (*read-syntax src port)
-    (*read port)))

pkgs/compiler-test/tests/compiler/embed/embed-me12.ss

@@ -1,2 +0,0 @@
-#reader(lib "embed-me12-rd.rkt" "tests" "compiler" "embed")
-"It goes to ~a!\n"

pkgs/compiler-test/tests/compiler/embed/embed-me13.rkt

@@ -1,4 +0,0 @@
-#lang racket/base
-(require racket/runtime-path)
-(define-runtime-module-path-index _mod "embed-me14.rkt")
-(dynamic-require _mod #f)

pkgs/compiler-test/tests/compiler/embed/embed-me14.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-(require "embed-me13.rkt")
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 14\n"))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me15-one.rkt

@@ -1,13 +0,0 @@
-#lang racket/base
-(define two 2)
-(provide two)
-
-(module* one #f
-  (require (submod "." ".." three))
-  (define one 1)
-  (provide one two three))
-
-(module three racket/base
-  (define three 3)
-  (provide three))
-

pkgs/compiler-test/tests/compiler/embed/embed-me15.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-(require (submod "embed-me15-one.rkt" one))
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is ~a.\n" (+ 9 one two three)))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me16.rkt

@@ -1,7 +0,0 @@
-#lang racket/base
-
-;; a `main' submodule:
-(module main racket/base
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "This is 16.\n"))
-    #:exists 'append))

pkgs/compiler-test/tests/compiler/embed/embed-me17.rkt

@@ -1,2 +0,0 @@
-#lang racket/base
-(require (submod "embed-me17a.rkt" sub))

pkgs/compiler-test/tests/compiler/embed/embed-me17a.rkt

@@ -1,9 +0,0 @@
-#lang racket
-
-(define print-17
-  (lambda () (printf "This is 17.\n")))
-
-(module+ sub
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    print-17
-    #:exists 'append))

pkgs/compiler-test/tests/compiler/embed/embed-me18.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-(require (submod tests/compiler/embed/embed-me18a sub))
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (dynamic-require '(submod tests/compiler/embed/embed-me18a sub) 'print-18)
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me18a.rkt

@@ -1,9 +0,0 @@
-#lang racket/base
-(module sub racket/base
-  (provide print-18)
-  (define (print-18)
-    (printf "This is 18.\n")))
-
-
-
-  

pkgs/compiler-test/tests/compiler/embed/embed-me19.rkt

@@ -1,14 +0,0 @@
-#lang racket/base
-(require racket/runtime-path)
-
-(define-runtime-module-path plai plai)
-(define-runtime-module-path plai-reader plai/lang/reader)
-(define-runtime-module-path runtime racket/runtime-config)
-
-(parameterize ([read-accept-reader #t])
-  (namespace-require 'racket/base)
-  (eval (read (open-input-string "#lang plai 10"))))
-
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 19.\n"))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me1b.rkt

@@ -1,9 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path
-         (for-syntax scheme/base))
-(define-runtime-path file '(lib "icons/file.gif"))
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 1b\n"))
-  #:exists 'append)
-

pkgs/compiler-test/tests/compiler/embed/embed-me1c.rkt

@@ -1,9 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path
-         (for-syntax scheme/base))
-(define-runtime-path file '(lib "etc.ss")) ; in mzlib
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 1c\n"))
-  #:exists 'append)
-

pkgs/compiler-test/tests/compiler/embed/embed-me1d.rkt

@@ -1,8 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path
-         (for-syntax scheme/base))
-(define-runtime-path file '(lib "file.gif" "icons"))
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 1d\n"))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me1e.rkt

@@ -1,8 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path
-         (for-syntax scheme/base))
-(define-runtime-path file '(lib "html"))
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (printf "This is 1e\n"))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me1f.rkt

@@ -1,12 +0,0 @@
-#lang scheme/base
-
-(require scheme/runtime-path)
-
-;; Check that relative paths are preserved:
-(define-runtime-path f1 "embed-me1f1.rktl")
-(define-runtime-path f2 "sub/embed-me1f2.rktl")
-
-(with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-  (lambda () (parameterize ([current-namespace (make-base-namespace)])
-               (load f1)))
-  #:exists 'append)

pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl

@@ -1 +0,0 @@
-(load-relative "sub/embed-me1f2.rktl")

pkgs/compiler-test/tests/compiler/embed/embed-me2.rkt

@@ -1,6 +0,0 @@
-(module embed-me2 mzscheme
-  (require "embed-me1.ss"
-	   mzlib/etc)
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "This is 2: ~a\n" true))
-    'append))

pkgs/compiler-test/tests/compiler/embed/embed-me20.rkt

@@ -1,7 +0,0 @@
-#lang racket/base
-
-;; like "embed-me16.rkt" using `module+'
-(module+ main
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "This is 20.\n"))
-    #:exists 'append))

pkgs/compiler-test/tests/compiler/embed/embed-me21.rkt

@@ -1,12 +0,0 @@
-#lang racket/base
-(require racket/match)
-
-;; check using `racket/match', particularly with a pattern
-;; that eneds run-time support that may go through a
-;; compile-time `lazy-require':
-
-(match "x"
-  [(pregexp "x")
-   (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-     (lambda () (printf "This is 21.\n"))
-     #:exists 'append)])

pkgs/compiler-test/tests/compiler/embed/embed-me22.rkt

@@ -1,6 +0,0 @@
-#lang racket/kernel
-
-(printf "This is 22.\n")
-
-(module configure-runtime racket/kernel
-  (printf "Configure!\n"))

pkgs/compiler-test/tests/compiler/embed/embed-me23.rkt

@@ -1,8 +0,0 @@
-#lang racket/base
-(require racket/serialize)
-
-(serializable-struct foo (a b))
-
-(define f (deserialize (serialize (foo 1 2))))
-(foo-a f)
-(foo-b f)

pkgs/compiler-test/tests/compiler/embed/embed-me24.rkt

@@ -1,3 +0,0 @@
-#lang racket
-
-"Ok"

pkgs/compiler-test/tests/compiler/embed/embed-me25.rkt

@@ -1,9 +0,0 @@
-#lang racket/base
-
-(module+ main
-  12)
-
-(module submod racket/base
-  11)
-
-10

pkgs/compiler-test/tests/compiler/embed/embed-me26.rkt

@@ -1,10 +0,0 @@
-#lang racket/base
-
-(module+ main
-  12)
-
-(module submod racket/base
-  11)
-
-10
-(require (submod "embed-me27.rkt" other-submod))

pkgs/compiler-test/tests/compiler/embed/embed-me27.rkt

@@ -1,3 +0,0 @@
-#lang racket/base
-
-(module+ other-submod 'y)

pkgs/compiler-test/tests/compiler/embed/embed-me28.rkt

@@ -1,14 +0,0 @@
-#lang racket/base
-(require racket/place)
-
-(define (go)
-  (place pch
-         (place-channel-put pch 28)))
-
-(module+ main                                                                                       
-  (define p (go))
-  (define n (place-channel-get p))
-  (void (place-wait p))
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "~a\n" n))
-    #:exists 'append))

pkgs/compiler-test/tests/compiler/embed/embed-me29-2.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-
-(module inside racket/base
-  (define inside 'inside)
-  (provide inside))

pkgs/compiler-test/tests/compiler/embed/embed-me29.rkt

@@ -1,5 +0,0 @@
-#lang racket/base
-
-(module main racket/base
-  (require (submod "embed-me29-2.rkt" inside))
-  inside)

pkgs/compiler-test/tests/compiler/embed/embed-me3.rkt

@@ -1,7 +0,0 @@
-(module embed-me3 mzscheme
-  (require mzlib/etc)
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () 
-      (printf "3 is here, too? ~a\n" true))
-    'append))
-

pkgs/compiler-test/tests/compiler/embed/embed-me4.rktl

@@ -1,4 +0,0 @@
-(with-output-to-file "stdout"
-  (lambda () (printf "This is the literal expression 4.\n"))
-  'append)
-

pkgs/compiler-test/tests/compiler/embed/embed-me5.rkt

@@ -1,6 +0,0 @@
-(module embed-me5 mzscheme
-  (require mred)
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () (printf "This is 5: ~s\n" button%))
-    'append))
-

pkgs/compiler-test/tests/compiler/embed/embed-me6.rkt

@@ -1,8 +0,0 @@
-(module embed-me6 mzscheme
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () 
-      (printf "This is 6\n")
-      (with-handlers ([void (lambda (exn) (printf "no etc.ss\n"))])
-	(printf "~a\n" (dynamic-require 'mzlib/etc 'true))))
-    'append))
-

pkgs/compiler-test/tests/compiler/embed/embed-me6b.rkt

@@ -1,8 +0,0 @@
-(module embed-me6b racket/base
-  (with-output-to-file (build-path (find-system-path 'temp-dir) "stdout")
-    (lambda () 
-      (printf "This is 6\n")
-      (with-handlers ([void (lambda (exn) (printf "no etc.ss\n"))])
-	(printf "~a\n" (and (dynamic-require 'racket/fixnum #f) #t))))
-    #:exists 'append))
-