cs: fix cross-module inlining for separate compilation

Commit fe708871bd broke cross-module inlining for modules that are
compiled in different Racket processes. The problem is that
cross-module information is represented by prefab structures, and the
change caused Chez Scheme's fasl for prefabs to generate a different
structure type on different runs.

To solve the problem, use `racket/fasl` for cross-module information,
instead. But cross-module information also has inlining information as
correlated objects, so make those supported by `racket/fasl`, too.
This commit is contained in:
Matthew Flatt 2019-06-15 09:07:21 -06:00
parent b40e247edd
commit f27dbb7951
10 changed files with 97 additions and 38 deletions

View File

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

View File

@ -27,10 +27,11 @@ output port or returning the byte string otherwise. The
The @racket[v] argument must be a value that could be @racket[quote]d
as a literal---that is, a value without syntax objects for which
@racket[(compile `(quote ,v))]
would work and be @racket[read]able after @racket[write]. The
byte string produced by @racket[s-exp->fasl] does not use the same
format as compiled code, however.
@racket[(compile `(quote ,v))] would work and be @racket[read]able
after @racket[write]---or it can include @tech{correlated
objects} mixed with those values. The byte string produced by
@racket[s-exp->fasl] does not use the same format as compiled code,
however.
Like @racket[(compile `(quote ,v))], @racket[s-exp->fasl] does not
preserve graph structure, support cycles, or handle non-@tech{prefab}
@ -67,7 +68,8 @@ fasl
@history[#:changed "6.90.0.21" @elem{Made @racket[s-exp->fasl] format version-independent
and added the @racket[#:keep-mutable?]
and @racket[#:datum-intern?] arguments.}]}
and @racket[#:datum-intern?] arguments.}
#:changed "7.3.0.7" @elem{Added support for @tech{correlated objects}.}]}
@; ----------------------------------------------------------------------

View File

@ -496,17 +496,17 @@ primitive.}
@deftogether[(
@defproc[(correlated? [v any/c]) boolean?]
@defproc[(correlated-source [stx correlated?]) any]
@defproc[(correlated-line [stx correlated?])
@defproc[(correlated-source [crlt correlated?]) any]
@defproc[(correlated-line [crlt correlated?])
(or/c exact-positive-integer? #f)]
@defproc[(correlated-column [stx correlated?])
@defproc[(correlated-column [crlt correlated?])
(or/c exact-nonnegative-integer? #f)]
@defproc[(correlated-position [stx correlated?])
@defproc[(correlated-position [crlt correlated?])
(or/c exact-positive-integer? #f)]
@defproc[(correlated-span [stx correlated?])
@defproc[(correlated-span [crlt correlated?])
(or/c exact-nonnegative-integer? #f)]
@defproc[(correlated-e [stx correlated?]) any]
@defproc[(correlated->datum [stx (or/c correlated? any/c)]) any]
@defproc[(correlated-e [crlt correlated?]) any]
@defproc[(correlated->datum [crlt (or/c correlated? any/c)]) any]
@defproc[(datum->correlated [v any/c]
[srcloc (or/c correlated? #f
(list/c any/c
@ -520,14 +520,14 @@ primitive.}
(or/c exact-positive-integer? #f)
(or/c exact-nonnegative-integer? #f)))
#f]
[prop (or/c correlated? #f)])
[prop (or/c correlated? #f) #f])
correlated?]
@defproc*[([(correlated-property [stx correlated?]
@defproc*[([(correlated-property [crlt correlated?]
[key any/c]
[val any/c])
correlated?]
[(correlated-property [stx correlated?] [key any/c]) any/c])]
@defproc[(correlated-property-symbol-keys [stx correlated?]) list?]
[(correlated-property [crlt correlated?] [key any/c]) any/c])]
@defproc[(correlated-property-symbol-keys [crlt correlated?]) list?]
)]{
Like @racket[syntax?], @racket[syntax-source], @racket[syntax-line],

View File

@ -3,7 +3,12 @@
(Section 'fasl)
(require racket/fasl)
(require racket/fasl
(only-in racket/linklet
correlated?
correlated-e
datum->correlated
correlated-property))
(define immutables
;; If you update this list, then also update `immutable-regression-bstr`:
@ -33,11 +38,11 @@
44+100i
45.0+100.0i
;; 46f0 <- test separately, because RacketCS doesn't support single-precision
(srcloc "x" 1 2 3 4)))
,(srcloc "x" 1 2 3 4)))
;; The fasl format is meant to be forward-compatible:
(define immutables-regression-bstr
#"racket/fasl:\0\200@\1\34&n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\16\bnineteen\200\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\355\376\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\201\177?\362\351\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\b\203\25cd4a0619fb0907bc00000\b\203\26-cd4a0619fb0907bc00000\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@\34\6\16\6srcloc\23\1xopqr")
#"racket/fasl:\0\2007\1\34&n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\16\bnineteen\200\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\355\376\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\201\177?\362\351\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\b\203\25cd4a0619fb0907bc00000\b\203\26-cd4a0619fb0907bc00000\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@&\23\1xopqr")
(for ([i (in-list immutables)])
(test i fasl->s-exp (s-exp->fasl i)))
@ -98,6 +103,17 @@
(test #t equal? r2 (fasl->s-exp (s-exp->fasl r2) #:datum-intern? #f))
(test #t equal? r3 (fasl->s-exp (s-exp->fasl r3) #:datum-intern? #f)))
(let* ([s (gensym)]
[c (datum->correlated (list s s)
(vector s 1 2 3 4))]
[c (correlated-property c 'key s)])
(define c2 (fasl->s-exp (s-exp->fasl c)))
(test #t correlated? c2)
(define e (correlated-e c2))
(test #t pair? e)
(test #t eq? (car e) (cadr e))
(test #t eq? (car e) (correlated-property c2 'key)))
(define (check-hash make-hash hash)
(let ([mut (make-hash)]
[immut (hash 'one 2 'three 4)])

View File

@ -1,5 +1,6 @@
#lang racket/base
(require '#%extfl
racket/linklet
(for-syntax racket/base)
"private/truncate-path.rkt"
"private/relative-path.rkt"
@ -93,10 +94,12 @@
(fasl-hash-type 36)
(fasl-immutable-hash-type 37)
(fasl-srcloc 38)
(fasl-srcloc-type 38)
(fasl-extflonum-type 39)
(fasl-correlated-type 40)
;; Unallocated numbers here are for future extensions
;; 100 to 255 is used for small integers:
@ -152,6 +155,14 @@
(loop k)
(for ([e (in-vector (struct->vector v) 1)])
(loop e)))]
[(srcloc? v)
(loop (srcloc-source v))]
[(correlated? v)
(loop (correlated-e v))
(loop (correlated-source v))
(for ([k (in-list (correlated-property-symbol-keys v))])
(loop k)
(loop (correlated-property v k)))]
[else (void)]))
(define (treat-immutable? v) (or (not keep-mutable?) (immutable? v)))
(define path->relative-path-elements (make-path->relative-path-elements))
@ -269,7 +280,7 @@
;; Convert to a string
(truncate-path src)]
[else src]))
(write-fasl-integer fasl-srcloc o)
(write-fasl-integer fasl-srcloc-type o)
(loop new-src)
(loop (srcloc-line v))
(loop (srcloc-column v))
@ -329,6 +340,16 @@
[(byte-regexp? v)
(write-byte (if (byte-pregexp? v) fasl-byte-pregexp-type fasl-byte-regexp-type) o)
(write-fasl-bytes (object-name v) o)]
[(correlated? v)
(write-byte fasl-correlated-type o)
(loop (correlated-e v))
(loop (srcloc (correlated-source v)
(correlated-line v)
(correlated-column v)
(correlated-position v)
(correlated-span v)))
(loop (for/list ([k (in-list (correlated-property-symbol-keys v))])
(cons k (correlated-property v k))))]
[else
(raise-arguments-error 'fasl-write
"cannot write value"
@ -468,8 +489,18 @@
(define len (read-fasl-integer i))
(for/fold ([ht ht]) ([j (in-range len)])
(hash-set ht (loop) (loop)))]
[(fasl-srcloc)
[(fasl-srcloc-type)
(srcloc (loop) (loop) (loop) (loop) (loop))]
[(fasl-correlated-type)
(define e (loop))
(define s (loop))
(define c (datum->correlated e (vector (srcloc-source s)
(srcloc-line s)
(srcloc-column s)
(srcloc-position s)
(srcloc-span s))))
(for/fold ([c c]) ([p (in-list (loop))])
(correlated-property c (car p) (cdr p)))]
[else
(cond
[(type . >= . fasl-small-integer-start)

View File

@ -472,15 +472,7 @@
(define (linklet-pack-exports-info! l)
(let ([info (linklet-exports-info l)])
(when (hash? info)
(let ([new-info
(cond
[(zero? (hash-count info)) #f]
[else
(let-values ([(o get) (open-bytevector-output-port)])
;; convert to a hashtable so the fasled form is compact and
;; doesn't have hash codes:
(fasl-write* (hash->eq-hashtable (hash-copy info)) o)
(get))])])
(let ([new-info (->fasl info)])
(linklet-exports-info-set! l new-info)))))
(define (linklet-unpack-exports-info! l)
@ -489,8 +481,7 @@
(let ([new-info
(cond
[(not info) (hasheq)]
[else
(eq-hashtable->hash (fasl-read (open-bytevector-input-port info)))])])
[else (fasl-> info)])])
(linklet-exports-info-set! l new-info)))))
(define compile-linklet

View File

@ -14,14 +14,18 @@
known-procedure
known-procedure/pure
known-procedure/succeeds
a-known-constant)
a-known-constant
->fasl
fasl->)
(import (except (chezpart)
datum->syntax)
(rename (rumble)
[correlated? rumble:correlated?]
[correlated-e rumble:correlated-e]
[correlated-property rumble:correlated-property]
[correlated-property-symbol-keys rumble:correlated-property-symbol-keys]
[datum->correlated rumble:datum->correlated]
[correlated->datum rumble:correlated->datum]
[correlated-source rumble:correlated-source]
[correlated-line rumble:correlated-line]
[correlated-column rumble:correlated-column]
@ -40,7 +44,9 @@
(hash 'syntax? rumble:correlated?
'syntax-e rumble:correlated-e
'syntax-property rumble:correlated-property
'syntax-property-symbol-keys rumble:correlated-property-symbol-keys
'datum->syntax rumble:datum->correlated
'syntax->datum rumble:correlated->datum
'syntax-source rumble:correlated-source
'syntax-line rumble:correlated-line
'syntax-column rumble:correlated-column

View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_W 7
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x

View File

@ -0,0 +1,9 @@
#lang racket/base
(require racket/fasl)
(provide ->fasl
fasl->)
;; Variants without keyword arguments:
(define (->fasl v) (s-exp->fasl v))
(define (fasl-> f) (fasl->s-exp f))

View File

@ -6,7 +6,8 @@
"xify.rkt"
"path.rkt"
"interpret.rkt"
"size.rkt")
"size.rkt"
"fasl.rkt")
(provide schemify-linklet
schemify-body
@ -27,4 +28,7 @@
interpretable-jitified-linklet
interpret-linklet
linklet-bigger-than?)
linklet-bigger-than?
->fasl
fasl->)