diff --git a/pkgs/racket-doc/scribblings/reference/compiler.scrbl b/pkgs/racket-doc/scribblings/reference/compiler.scrbl index 6881712f8b..84147c665f 100644 --- a/pkgs/racket-doc/scribblings/reference/compiler.scrbl +++ b/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} diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index c07fb6838d..e103bd733f 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/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) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index a4df33822c..c06c25a372 100644 --- a/racket/src/cs/linklet.sls +++ b/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 diff --git a/racket/src/cs/linklet/annotation.ss b/racket/src/cs/linklet/annotation.ss index 1696cf6477..f9e7d8a4f6 100644 --- a/racket/src/cs/linklet/annotation.ss +++ b/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)])) diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index 1e820ccd7d..ff9debebe5 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/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))) diff --git a/racket/src/schemify/fasl.rkt b/racket/src/schemify/fasl.rkt index 27080024c5..d0d7c4d0ad 100644 --- a/racket/src/schemify/fasl.rkt +++ b/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))