expander: recompile converts from machine-independent to -specific

Actually, the machine-independent-to-specific part is trivial. The
hard part was making `compiled-expression-recompile` enable
cross-linklet optimization as it recompiles, since that involves
pulling apart metadata and putting it back together afterward.

pkgs/racket-doc/scribblings/reference/eval.scrbl

@@ -528,12 +528,12 @@ handler} in tail position with @racket[stx].}
 
 @defproc[(compiled-expression-recompile [ce compiled-expression?]) compiled-expression?]{
 
-Recompiles @racket[ce], effectively re-running optimization passes to
+Recompiles @racket[ce]. If @racket[ce] was compiled as
-produce an equivalent compiled form with potentially different
+machine-independent and @racket[compile-machine-independent] is
-performance characteristics.
+@racket[#f], then recompiling effectively converts to the current
-
+machine format. Otherwise, recompiling effectively re-runs
-If @racket[ce] includes module forms, then only phase-0 code in the
+optimization passes to produce an equivalent compiled form with
-immediate module (not in submodules) is recompiled.
+potentially different performance characteristics.
 
 @history[#:added "6.3"]}
 

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

@@ -2838,6 +2838,54 @@ case of module-leve bindings; it doesn't cover local bindings.
 
 (dynamic-require ''assigns-to-self-variable-through-namespace #f)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check machine-independent compilation and
+;; machine-dependent recompilation
+
+(let ()
+  (define m (parameterize ([compile-machine-independent #t])
+              (compile
+               ;; The intent of this module is to exercise cross-module
+               ;; inlining when moving from machine-independent to
+               ;; machine-dependent. The `x` should be inlined from a submodule
+               ;; and `map` should be inlined --- but we don't actually
+               ;; check, currently.
+               `(module should-inline-when-fully-compiled racket/base
+                  (module sub racket/base
+                    (define x 1)
+                    (provide x))
+                  (require 'sub)
+                  (define (f g)
+                    (map (lambda (y) x) g))))))
+
+  (define (check-vm bstr vm)
+    (define vm-bstr (string->bytes/utf-8 (symbol->string vm)))
+    (define expect (bytes-append #"#~"
+                                 (bytes (string-length (version)))
+                                 (string->bytes/utf-8 (version))
+                                 (bytes (bytes-length vm-bstr))
+                                 vm-bstr))
+    (test #t equal? expect (subbytes bstr 0 (min (bytes-length bstr) (bytes-length expect)))))
+
+  (define o (open-output-bytes))
+  (write m o)
+  (check-vm (get-output-bytes o) 'linklet)
+  
+  (define m2
+    (parameterize ([read-accept-compiled #t])
+      (read (open-input-bytes (get-output-bytes o)))))
+  
+  (define re-m (compiled-expression-recompile m))
+  (define re-m2 (compiled-expression-recompile m2))
+
+  (define re-o (open-output-bytes))
+  (write re-m re-o)
+  (check-vm (get-output-bytes re-o) (system-type 'vm))
+
+  (define re-o2 (open-output-bytes))
+  (write re-m2 re-o2)
+  (check-vm (get-output-bytes re-o2) (system-type 'vm)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/expander/compile/form.rkt

@@ -27,7 +27,7 @@
          "correlated-linklet.rkt")
 
 (provide compile-forms
-
+         compile-module-linklet
          compile-namespace-scopes)
 
 (struct link-info (link-module-uses imports extra-inspectorsss def-decls))
@@ -386,6 +386,7 @@
 ;; means that the set of imports can change: return a compiled linklet
 ;; and a list of `module-use*`
 (define (compile-module-linklet body-linklet
+                                #:compile-linklet [compile-linklet compile-linklet]
                                 #:body-imports body-imports
                                 #:body-import-instances body-import-instances
                                 #:get-module-linklet-info get-module-linklet-info

racket/src/expander/compile/module.rkt

@@ -200,20 +200,8 @@
                  (performance-region
                   ['compile 'module 'linklet]
                   (compile-linklet s 'decl))))
-           `(linklet
+           (generate-module-declaration-linklet mpis self requires provides
-             ;; imports
+                                                phase-to-link-module-uses-expr))))
-             (,deserialize-imports
-              [,mpi-vector-id])
-             ;; exports
-             (self-mpi
-              requires
-              provides
-              phase-to-link-modules)
-             ;; body
-             (define-values (self-mpi) ,(add-module-path-index! mpis self))
-             (define-values (requires) ,(generate-deserialize requires mpis #:syntax-support? #f))
-             (define-values (provides) ,(generate-deserialize provides mpis #:syntax-support? #f))
-             (define-values (phase-to-link-modules) ,phase-to-link-module-uses-expr)))))
    
    ;; Assemble a linklet that shifts syntax objects on demand.
    ;; Include an encoding of the root expand context, if any, so that
@@ -301,15 +289,7 @@
                            (performance-region
                             ['compile 'module 'linklet]
                             (compile-linklet s 'data))))
-           `(linklet
+           (generate-module-data-linklet mpis))))
-             ;; imports
-             (,deserialize-imports)
-             ;; exports
-             (,mpi-vector-id)
-             ;; body
-             (define-values (,inspector-id) (current-code-inspector))
-             (define-values (,mpi-vector-id)
-               ,(generate-module-path-index-deserialize mpis))))))
    
    ;; Combine linklets with other metadata as the bundle:
    (define bundle

racket/src/expander/compile/recompile.rkt

@@ -1,26 +1,206 @@
 #lang racket/base
 (require "../host/linklet.rkt"
          "../eval/reflect.rkt"
-         "linklet.rkt")
+         "../compile/form.rkt"
+         "../compile/module.rkt"
+         "../namespace/namespace.rkt"
+         "../namespace/module.rkt"
+         "../common/module-path.rkt"
+         "linklet.rkt"
+         "correlated-linklet.rkt"
+         "form.rkt"
+         "serialize.rkt"
+         "reserved-symbol.rkt"
+         "instance.rkt"
+         "extra-inspector.rkt"
+         "compiled-in-memory.rkt")
 
 (provide compiled-expression-recompile)
 
 (define (compiled-expression-recompile c)
   (unless (compiled-expression? c)
     (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c))
+  (cond
+    [(compile-machine-independent)
+     ;; There's no use for machine-independent mode, and
+     ;; `recompile-bundle` assumes that it should actually compile
+     c]
+    [(or (linklet-bundle? c)
+         (linklet-directory? c))
+     (define ns (current-namespace))
+     ;; First, extract all bundles, so we can implement cross-module
+     ;; optimizations involving submodules
+     (define bundles (extract-linklet-bundles c '() #hash()))
+     ;; Recompile each bundle
+     (define recompileds (make-hash))
+     (define (force-recompile-bundle k)
+       (unless (hash-ref recompileds k #f)
+         (hash-set! recompileds k 'in-process)
+         (define b (hash-ref bundles k #f))
+         (unless b
+           (raise-arguments-error 'compiled-expression-recompile
+                                  "cannot find submodule"
+                                  "submodule path" k))
+         (hash-set! recompileds k (recompile-bundle b
+                                                    force-recompile-bundle
+                                                    ns)))
+       (hash-ref recompileds k))
+     (for ([k (in-hash-keys bundles)])
+       (force-recompile-bundle k))
+     (replace-linklet-bundles c '() recompileds)]
+    [else
+     ;; For now, we just give up on compiled-in-memory information,
+     ;; because the intended use cases are with serialization --- but
+     ;; beware that we may lose detailed inspector-based access:
+     (compiled-expression-recompile (compiled-in-memory-linklet-directory c))]))
+
+;; ----------------------------------------
+
+(define (extract-linklet-bundles c rev-path accum)
   (cond
     [(linklet-bundle? c)
-     (hash->linklet-bundle
+     (hash-set accum (reverse rev-path) c)]
-      (for/hasheq ([(k v) (in-hash (linklet-bundle->hash c))])
+    [(linklet-directory? c)
-        (cond
+     (for/fold ([accum accum]) ([(k v) (in-hash (linklet-directory->hash c))])
-          [(linklet? v) (values k (recompile-linklet v))]
+       (cond
-          [else (values k v)])))]
+         [(symbol? k)
+          (extract-linklet-bundles v (cons k rev-path) accum)]
+         [(not k)
+          (extract-linklet-bundles v rev-path accum)]
+         [else accum]))]
+    [else accum]))
+
+(define (replace-linklet-bundles c rev-path recompileds)
+  (cond
+    [(linklet-bundle? c)
+     (recompiled-bundle (hash-ref recompileds (reverse rev-path)))]
     [(linklet-directory? c)
      (hash->linklet-directory
       (for/hasheq ([(k v) (in-hash (linklet-directory->hash c))])
-        (cond
+        (values k
-          [(compiled-expression? v)
+                (cond
-           (values k (compiled-expression-recompile v))]
+                  [(symbol? k)
-          [else
+                   (replace-linklet-bundles v (cons k rev-path) recompileds)]
-           (values k v)])))]
+                  [(not k)
+                   (replace-linklet-bundles v rev-path recompileds)]))))]
     [else c]))
+
+;; ----------------------------------------
+
+(struct recompiled (bundle
+                    ;; The remaining information is used for cross-linklet
+                    ;; inlnining among submodules within a linklet directory
+                    phase-to-link-module-uses
+                    self)
+  #:authentic)
+
+;; Takes a bundle and returns a recompiled
+(define (recompile-bundle b get-submodule-recompiled ns)
+  ;; We have to execute the parts of the bundle that supply data, such
+  ;; as the mpis and link modules, then use that data for cross-module
+  ;; optimization while recompiling the per-phase body units, and then
+  ;; regenerate the data linklets because optimization can add new
+  ;; linklet import.s
+  (define h (linklet-bundle->hash b))
+
+  (define (eval-linklet* l)
+    (eval-linklet (force-compile-linklet l)))
+  (define data-instance
+    (instantiate-linklet (eval-linklet* (hash-ref h 'data))
+                         (list deserialize-instance)))
+  (define declaration-instance
+    (instantiate-linklet (eval-linklet* (hash-ref h 'decl))
+                         (list deserialize-instance
+                               data-instance)))
+  (define (decl key)
+    (instance-variable-value declaration-instance key))
+
+  (define mpis (make-module-path-index-table))
+  ;; Add current mpis in order, so existing references will stay correct
+  (for ([mpi (in-vector (instance-variable-value data-instance mpi-vector-id))])
+    (add-module-path-index! mpis mpi))
+
+  (define self (decl 'self-mpi))
+  (define phase-to-link-modules (decl 'phase-to-link-modules))
+
+  (define (find-submodule mod-name phase)
+    ;; If `mod-name` refers to a submodule in the same linklet directory,
+    ;; then we need to force that one to be recompiled and then return it.
+    (define find-l (resolved-module-path-name mod-name))
+    (define self-l (resolved-module-path-name (module-path-index-resolve self)))
+    (define (root-of l) (if (pair? l) (car l) l))
+    (cond
+      [(equal? (root-of find-l) (root-of self-l))
+       (define r (get-submodule-recompiled (if (pair? find-l) (cdr find-l) '())))
+       (when (eq? r 'in-process)
+         (raise-arguments-error 'compiled-expression-recompile
+                                "cycle in linklet imports"))
+       (define b (recompiled-bundle r))
+       (define linklet
+         (or (hash-ref (linklet-bundle->hash b) phase #f)
+             (raise-arguments-error 'compiled-expression-recompile
+                                    "cannot find submodule at phase"
+                                    "submodule" mod-name
+                                    "phase" phase)))
+       (module-linklet-info linklet
+                            (hash-ref (recompiled-phase-to-link-module-uses r) phase #f)
+                            (recompiled-self r)
+                            #f ; inspector is the same as the module being compiled
+                            (current-code-inspector) ; compile-time inspector is now
+                            #f)]
+      [else #f]))
+
+  (define body-linklets+module-use*s
+    (for/hash ([(phase body-linklet) (in-hash h)]
+               #:when (exact-integer? phase))
+      (define module-use*s
+        (module-uses-add-extra-inspectorsss (hash-ref phase-to-link-modules phase)
+                                            #f))
+      (define-values (linklet new-module-use*s)
+        (compile-module-linklet (if (correlated-linklet? body-linklet)
+                                    (correlated-linklet-expr body-linklet)
+                                    body-linklet)
+                                #:compile-linklet (if (correlated-linklet? body-linklet)
+                                                      compile-linklet
+                                                      recompile-linklet)
+                                #:body-imports `([,get-syntax-literal!-id]
+                                                 [,set-transformer!-id])
+                                #:body-import-instances (list empty-syntax-literals-instance
+                                                              empty-module-body-instance)
+                                #:get-module-linklet-info find-submodule
+                                #:serializable? #t
+                                #:module-use*s module-use*s
+                                #:cross-linklet-inlining? #t
+                                #:namespace ns))
+      (values phase (cons linklet new-module-use*s))))
+
+  (define h/new-body-linklets
+    (for/fold ([h h]) ([(phase l+mu*s) (in-hash body-linklets+module-use*s)])
+      (hash-set h phase (car l+mu*s))))
+
+  (define phase-to-link-module-uses
+    (for/hasheq ([(phase l+mu*s) (in-hash body-linklets+module-use*s)])
+      (values phase (module-uses-strip-extra-inspectorsss (cdr l+mu*s)))))
+  
+  (define phase-to-link-module-uses-expr
+    (serialize-phase-to-link-module-uses phase-to-link-module-uses mpis))
+
+  (define data-linklet
+    (compile-linklet (generate-module-data-linklet mpis) 'data))
+
+  (define declaration-linklet
+    (compile-linklet (generate-module-declaration-linklet mpis self 
+                                                          (decl 'requires)
+                                                          (decl 'provides)
+                                                          phase-to-link-module-uses-expr)
+                     'decl))
+
+  (define new-bundle
+    (hash->linklet-bundle (let* ([h h/new-body-linklets]
+                                 [h (hash-set h 'data data-linklet)]
+                                 [h (hash-set h 'decl declaration-linklet)])
+                            h)))
+
+  (recompiled new-bundle
+              phase-to-link-module-uses
+              self))

racket/src/expander/compile/serialize.rkt

@@ -73,7 +73,10 @@
          add-module-path-index!/pos
          generate-module-path-index-deserialize
          mpis-as-vector
-         
+
+         generate-module-data-linklet
+         generate-module-declaration-linklet
+
          generate-deserialize
 
          deserialize-instance
@@ -196,6 +199,36 @@
            (or (has-symbol? (car d) vars)
                (has-symbol? (cdr d) vars)))))
 
+;; ----------------------------------------
+
+(define (generate-module-data-linklet mpis)
+  `(linklet
+    ;; imports
+    (,deserialize-imports)
+    ;; exports
+    (,mpi-vector-id)
+    ;; body
+    (define-values (,inspector-id) (current-code-inspector))
+    (define-values (,mpi-vector-id)
+      ,(generate-module-path-index-deserialize mpis))))
+
+(define (generate-module-declaration-linklet mpis self requires provides
+                                             phase-to-link-module-uses-expr)
+  `(linklet
+    ;; imports
+    (,deserialize-imports
+     [,mpi-vector-id])
+    ;; exports
+    (self-mpi
+     requires
+     provides
+     phase-to-link-modules)
+    ;; body
+    (define-values (self-mpi) ,(add-module-path-index! mpis self))
+    (define-values (requires) ,(generate-deserialize requires mpis #:syntax-support? #f))
+    (define-values (provides) ,(generate-deserialize provides mpis #:syntax-support? #f))
+    (define-values (phase-to-link-modules) ,phase-to-link-module-uses-expr)))
+
 ;; ----------------------------------------
 ;; Module-use serialization --- as an expression, like module path
 ;; indexes, and unlike everything else

racket/src/expander/demo.rkt

@@ -17,15 +17,30 @@
   (expand (namespace-syntax-introduce (datum->syntax #f e) ns)
           ns))
 
-(define (compile+eval-expression e #:namespace [ns demo-ns])
+(define (expand+compile-expression e
+                                   #:namespace [ns demo-ns]
+                                   #:serializable? [serializable? #f])
   (define exp-e (expand-expression e #:namespace ns))
-  (define c (compile (if check-reexpand? exp-e e) ns check-serialize?))
+  (define c (compile (if check-reexpand? exp-e e) ns (or serializable?
+                                                         check-serialize?)))
   (define ready-c (if check-serialize?
                       (let ([o (open-output-bytes)])
                         (display c o)
                         (parameterize ([read-accept-compiled #t])
                           (read (open-input-bytes (get-output-bytes o)))))
                       c))
+  (values exp-e ready-c))
+
+(define (compile-expression e
+                            #:namespace [ns demo-ns]
+                            #:serializable? [serializable? #f])
+  (define-values (exp-e ready-c)
+    (expand+compile-expression e #:namespace ns #:serializable? serializable?))
+  ready-c)
+
+(define (compile+eval-expression e #:namespace [ns demo-ns])
+  (define-values (exp-e ready-c)
+    (expand+compile-expression e #:namespace ns))
   (values exp-e
           (eval ready-c ns)))
 
@@ -1421,3 +1436,19 @@
                         (quote-syntax car))
      (free-identifier=? (syntax-binding-set->syntax bs 'cdr)
                         (quote-syntax cdr)))))
+
+;; ----------------------------------------
+;; Machine-independent compilation format and recompilation
+
+(let ([mi-c (parameterize ([compile-machine-independent #t])
+              (compile-expression `(module to-recompile '#%kernel
+                                     (define-values (x) 0)
+                                     (print x)
+                                     (newline))
+                                  #:serializable? #t))])
+  (parameterize ([current-namespace demo-ns])
+    (define c2 (compiled-expression-recompile mi-c))
+    (eval c2 demo-ns)
+    (check-print
+     (namespace-require ''to-recompile demo-ns)
+     0)))

racket/src/expander/main.rkt

@@ -30,6 +30,8 @@
          "boot/runtime-primitive.rkt"
          "boot/handler.rkt"
          "syntax/api.rkt"
+         (only-in "compile/recompile.rkt"
+                  compiled-expression-recompile)
          (only-in racket/private/config find-main-config)
          (only-in "syntax/cache.rkt" cache-place-init!)
          (only-in "syntax/scope.rkt" scope-place-init!)
@@ -126,7 +128,9 @@
          read-accept-compiled
 
          syntax-shift-phase-level
-         bound-identifier=?)
+         bound-identifier=?
+
+         compiled-expression-recompile)
 
 ;; ----------------------------------------