cs: fix handling of cross-module inline with strange srcloc

When the srcloc-enriched S-expression representation a function that
is available for cross-module inlining has a source that is not a
path, string, or symbol, then the source has to be dropped in the
module's serialized form.

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

@@ -112,6 +112,9 @@ forms or adjust the way forms are displayed:
          compilation of form that were previously prepared by
          compilation with @envvar{PLT_CS_JIT} set}
 
+   @item{@envvar-indexed{PLT_LINKLET_SHOW_PATHS} --- show lifted
+         path and serialization information alongside a schemified form}
+
    @item{@envvar-indexed{PLT_LINKLET_SHOW_KNOWN} --- show recorded
          known-binding information alongside a schemified form}
 

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

@@ -3369,4 +3369,20 @@ case of module-leve bindings; it doesn't cover local bindings.
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(let ([m '(module cross-inline-function-with-strange-srcloc racket/base
+            (require (for-syntax racket/base))
+            (define-syntax (m stx)
+              (struct opaque ())
+              #`(begin
+                  (provide f)
+                  (define f
+                    #,(datum->syntax #'here
+                                     '(lambda (x) x)
+                                     (vector (opaque) 1 2 3 4)))))
+            (m))])
+  ;; Make sure this doesn't error:
+  (write (compile m) (open-output-bytes)))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (report-errs)

racket/src/cs/linklet.sls

@@ -180,6 +180,7 @@
   (define post-lambda-on? (getenv "PLT_LINKLET_SHOW_POST_LAMBDA"))
   (define post-interp-on? (getenv "PLT_LINKLET_SHOW_POST_INTERP"))
   (define jit-demand-on? (getenv "PLT_LINKLET_SHOW_JIT_DEMAND"))
+  (define paths-on? (getenv "PLT_LINKLET_SHOW_PATHS"))
   (define known-on? (getenv "PLT_LINKLET_SHOW_KNOWN"))
   (define cp0-on? (getenv "PLT_LINKLET_SHOW_CP0"))
   (define assembly-on? (getenv "PLT_LINKLET_SHOW_ASSEMBLY"))
@@ -189,6 +190,7 @@
                        post-lambda-on?
                        post-interp-on?
                        jit-demand-on?
+                       paths-on?
                        known-on?
                        cp0-on?
                        assembly-on?
@@ -466,7 +468,7 @@
   (define (linklet-pack-exports-info! l)
     (let ([info (linklet-exports-info l)])
       (when (hash? info)
-        (let ([new-info (->fasl info)])
+        (let ([new-info (->fasl info fixup-correlated-srclocs)])
           (linklet-exports-info-set! l new-info)))))
 
   (define (linklet-unpack-exports-info! l)
@@ -588,6 +590,8 @@
            (if (eq? format 'interpret)
                (interpretable-jitified-linklet impl-lam serializable?)
                (correlated->annotation impl-lam serializable? sfd-cache))))
+       (when paths-on?
+         (show "paths" paths))
        (when known-on?
          (show "known" (hash-map exports-info (lambda (k v) (list k v)))))
        (when (and cp0-on? (eq? format 'compile))
@@ -602,6 +606,8 @@
                                 (cross-compile-to-bytevector cross-machine impl format)
                                 (compile-to-bytevector impl format))
                             (values (compile-to-proc impl paths format) '#()))])
+            (when paths-on?
+              (show "source paths" sfd-paths))
             (let ([lk (make-linklet code
                                     paths
                                     sfd-paths

racket/src/cs/linklet/annotation.ss

@@ -92,3 +92,20 @@
           s
           (cons a d)))]
    [else s]))
+
+;; --------------------------------------------------
+
+;; A correlated might have a srcloc that has a source that cannot be
+;; marshaled; handle that at the last minute by discarding the source
+(define (fixup-correlated-srclocs v)
+  (cond
+    [(srcloc? v)
+     (srcloc #f
+             (srcloc-line v)
+             (srcloc-column v)
+             (srcloc-position v)
+             (srcloc-span v))]
+    [else
+     (raise-arguments-error 'fixup-correlated-srclocs
+                            "cannot fixup value"
+                            "value" v)]))

racket/src/cs/schemified/schemify.scm

@@ -60141,5 +60141,13 @@
                      (let ((d_2 (cdr (unwrap d_1)))) d_2)))))
             (<= (body-leftover-size_0 serializable?_0 body_0 size_0) 0))
           (error 'match "failed ~e" e_0))))))
-(define ->fasl (lambda (v_0) (s-exp->fasl.1 #f #f #f v_0 #f)))
+(define ->fasl
+  (let ((->fasl_0
+         (|#%name|
+          ->fasl
+          (lambda (v2_0 handle-fail1_0)
+            (begin (s-exp->fasl.1 #f handle-fail1_0 #f v2_0 #f))))))
+    (case-lambda
+     ((v_0) (->fasl_0 v_0 #f))
+     ((v_0 handle-fail1_0) (->fasl_0 v_0 handle-fail1_0)))))
 (define fasl-> (lambda (f_0) (fasl->s-exp.1 #t unsafe-undefined f_0)))

racket/src/schemify/fasl.rkt

@@ -5,5 +5,5 @@
          fasl->)
 
 ;; Variants without keyword arguments:
-(define (->fasl v) (s-exp->fasl v))
+(define (->fasl v [handle-fail #f]) (s-exp->fasl v #:handle-fail handle-fail))
 (define (fasl-> f) (fasl->s-exp f))