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:
parent
b40e247edd
commit
f27dbb7951
|
@ -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]))
|
||||
|
|
|
@ -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}.}]}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
|
|
|
@ -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],
|
||||
|
|
|
@ -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)])
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
9
racket/src/schemify/fasl.rkt
Normal file
9
racket/src/schemify/fasl.rkt
Normal 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))
|
|
@ -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->)
|
||||
|
|
Loading…
Reference in New Issue
Block a user