expander: repair top-level compilation to machine-independent

pkgs/racket-test-core/tests/racket/module.rktl

@@ -2932,7 +2932,13 @@ case of module-leve bindings; it doesn't cover local bindings.
 
   (define re-o2 (open-output-bytes))
   (write re-m2 re-o2)
-  (check-vm (get-output-bytes re-o2) (system-type 'vm)))
+  (check-vm (get-output-bytes re-o2) (system-type 'vm))
+
+  ;; Check top-level compilation:
+  (define tl-o (open-output-bytes))
+  (parameterize ([current-compile-target-machine #f])
+    (write (compile '(begin (display "hi") (newline))) tl-o))
+  (check-vm (get-output-bytes tl-o) 'linklet))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Make sure `(define-values (id ...) (values rhs ...))` is not

racket/src/expander/compile/multi-top-data.rkt

@@ -4,6 +4,7 @@
          "header.rkt"
          "eager-instance.rkt"
          "reserved-symbol.rkt"
+         "correlated-linklet.rkt"
          "../host/linklet.rkt")
 
 (provide build-shared-data-linklet)
@@ -21,7 +22,8 @@
 ;; compilation. See "../eval/multi-top.rkt" for that part, which is
 ;; the run-time complement to the encoding here.
 
-(define (build-shared-data-linklet cims ns)
+(define (build-shared-data-linklet cims ns
+                                   #:to-correlated-linklet? to-correlated-linklet?)
   ;; Gather all mpis:
   (define mpis (make-module-path-index-table))
   (define mpi-trees
@@ -64,7 +66,7 @@
       ,@(for/list ([phase-to-link-module-uses (in-list (reverse module-uses-tables))])
           (serialize-phase-to-link-module-uses phase-to-link-module-uses mpis))))
   
-  (compile-linklet
+  (define linklet-s
    `(linklet
      ;; imports
      (,deserialize-imports
@@ -82,7 +84,11 @@
      (define-values (phase-to-link-modules-vector) ,phase-to-link-module-uses-expr)
      (define-values (phase-to-link-modules-trees) ',phase-to-link-module-uses-trees)
      (define-values (syntax-literals) ,syntax-literals-expr)
-     (define-values (syntax-literals-trees) ',syntax-literals-trees))))
+     (define-values (syntax-literals-trees) ',syntax-literals-trees)))
+
+  (if to-correlated-linklet?
+      (make-correlated-linklet linklet-s #f)
+      (compile-linklet linklet-s)))
 
 ;; ----------------------------------------
 

racket/src/expander/compile/multi-top.rkt

@@ -41,7 +41,10 @@
                                       (hash->linklet-bundle
                                        (hasheq
                                         0
-                                        (build-shared-data-linklet cims ns))))))
+                                        (build-shared-data-linklet
+                                         cims
+                                         ns
+                                         #:to-correlated-linklet? to-correlated-linklet?))))))
                    sequence-ht))
     (compiled-in-memory (hash->linklet-directory ht)
                         #f ; self

racket/src/racket/src/startup.inc

@@ -33583,9 +33583,14 @@ static const char *startup_source =
 "(values #f #f)))))))"
 "(let-values()(values #f #f))))))))))))"
 "(define-values"
-"(build-shared-data-linklet)"
+"(build-shared-data-linklet5.1)"
-"(lambda(cims_0 ns_0)"
+"(lambda(to-correlated-linklet?1_0 cims3_0 ns4_0)"
 "(begin"
+" 'build-shared-data-linklet5"
+"(let-values(((cims_0) cims3_0))"
+"(let-values(((ns_0) ns4_0))"
+"(let-values(((to-correlated-linklet?_0) to-correlated-linklet?1_0))"
+"(let-values()"
 "(let-values(((mpis_0)(make-module-path-index-table)))"
 "(let-values(((mpi-trees_0)"
 "(map-cim-tree"
@@ -33605,7 +33610,9 @@ static const char *startup_source =
 " 'for-loop"
 "(if(unsafe-fx< pos_0 len_0)"
 "(let-values(((mpi_0)"
-"(unsafe-vector-ref vec_0 pos_0)))"
+"(unsafe-vector-ref"
+" vec_0"
+" pos_0)))"
 "(let-values(((vec_2 i_1)"
 "(let-values(((vec_2) vec_1)"
 "((i_1) i_0))"
@@ -33634,7 +33641,10 @@ static const char *startup_source =
 " 1)))))))"
 "(values vec_3 i_2)))))"
 "(if(not #f)"
-"(for-loop_0 vec_2 i_1(unsafe-fx+ 1 pos_0))"
+"(for-loop_0"
+" vec_2"
+" i_1"
+"(unsafe-fx+ 1 pos_0))"
 "(values vec_2 i_1))))"
 "(values vec_1 i_0))))))"
 " for-loop_0)"
@@ -33647,7 +33657,9 @@ static const char *startup_source =
 "(map-cim-tree"
 " cims_0"
 "(lambda(cim_0)"
-"(add-syntax-literals! syntax-literals_0(compiled-in-memory-syntax-literals cim_0))))))"
+"(add-syntax-literals!"
+" syntax-literals_0"
+"(compiled-in-memory-syntax-literals cim_0))))))"
 "(let-values(((module-uses-tables_0) null))"
 "(let-values(((module-uses-tables-count_0) 0))"
 "(let-values(((phase-to-link-module-uses-trees_0)"
@@ -33700,7 +33712,7 @@ static const char *startup_source =
 " for-loop_0)"
 " null"
 " lst_0)))))))"
-"(1/compile-linklet"
+"(let-values(((linklet-s_0)"
 "(list"
 " 'linklet"
 "(list deserialize-imports eager-instance-imports)"
@@ -33711,9 +33723,15 @@ static const char *startup_source =
 " phase-to-link-modules-trees"
 " syntax-literals"
 " syntax-literals-trees))"
-"(list 'define-values(list mpi-vector-id)(generate-module-path-index-deserialize mpis_0))"
+"(list"
+" 'define-values"
+"(list mpi-vector-id)"
+"(generate-module-path-index-deserialize mpis_0))"
 "(list 'define-values '(mpi-vector-trees)(list 'quote mpi-trees_0))"
-"(list 'define-values '(phase-to-link-modules-vector) phase-to-link-module-uses-expr_0)"
+"(list"
+" 'define-values"
+" '(phase-to-link-modules-vector)"
+" phase-to-link-module-uses-expr_0)"
 "(list"
 " 'define-values"
 " '(phase-to-link-modules-trees)"
@@ -33722,7 +33740,10 @@ static const char *startup_source =
 "(list"
 " 'define-values"
 " '(syntax-literals-trees)"
-"(list 'quote syntax-literals-trees_0))))))))))))))))"
+"(list 'quote syntax-literals-trees_0)))))"
+"(if to-correlated-linklet?_0"
+"(make-correlated-linklet linklet-s_0 #f)"
+"(1/compile-linklet linklet-s_0)))))))))))))))))))"
 "(define-values"
 "(map-cim-tree)"
 "(lambda(cims_0 proc_0)"
@@ -33773,7 +33794,7 @@ static const char *startup_source =
 "(begin"
 " 'compiled-tops->compiled-top8"
 "(let-values(((all-cims_0) all-cims7_0))"
-"(let-values()"
+"(let-values(((to-correlated-linklet?_0) to-correlated-linklet?1_0))"
 "(let-values(((merge-serialization?_0) merge-serialization?2_0))"
 "(let-values(((ns_0) namespace3_0))"
 "(let-values()"
@@ -33832,7 +33853,16 @@ static const char *startup_source =
 "(hash->linklet-directory"
 "(hasheq"
 " #f"
-"(hash->linklet-bundle(hasheq 0(build-shared-data-linklet cims_0 ns_0))))))"
+"(hash->linklet-bundle"
+"(hasheq"
+" 0"
+"(let-values(((cims11_0) cims_0)"
+"((ns12_0) ns_0)"
+"((to-correlated-linklet?13_0) to-correlated-linklet?_0))"
+"(build-shared-data-linklet5.1"
+" to-correlated-linklet?13_0"
+" cims11_0"
+" ns12_0)))))))"
 " sequence-ht_0)))"
 "(compiled-in-memory1.1"
 "(hash->linklet-directory ht_0)"