diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index e68897e9be..a6632b56af 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -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])) diff --git a/pkgs/racket-doc/scribblings/reference/fasl.scrbl b/pkgs/racket-doc/scribblings/reference/fasl.scrbl index 2b6d2a2c48..d3027d849e 100644 --- a/pkgs/racket-doc/scribblings/reference/fasl.scrbl +++ b/pkgs/racket-doc/scribblings/reference/fasl.scrbl @@ -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}.}]} @; ---------------------------------------------------------------------- diff --git a/pkgs/racket-doc/scribblings/reference/linklet.scrbl b/pkgs/racket-doc/scribblings/reference/linklet.scrbl index 8bb9b9cd1a..287dcc76e2 100644 --- a/pkgs/racket-doc/scribblings/reference/linklet.scrbl +++ b/pkgs/racket-doc/scribblings/reference/linklet.scrbl @@ -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], diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl index b5ed8386e9..d3a36fa61c 100644 --- a/pkgs/racket-test-core/tests/racket/fasl.rktl +++ b/pkgs/racket-test-core/tests/racket/fasl.rktl @@ -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)]) diff --git a/racket/collects/racket/fasl.rkt b/racket/collects/racket/fasl.rkt index ba918fa8e4..0afcef6617 100644 --- a/racket/collects/racket/fasl.rkt +++ b/racket/collects/racket/fasl.rkt @@ -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) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 06461afa83..4b9d377c1e 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -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 diff --git a/racket/src/cs/schemify.sls b/racket/src/cs/schemify.sls index 86106ff02d..7c688bc71f 100644 --- a/racket/src/cs/schemify.sls +++ b/racket/src/cs/schemify.sls @@ -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 diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 0b63d23e0b..9154979438 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -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 diff --git a/racket/src/schemify/fasl.rkt b/racket/src/schemify/fasl.rkt new file mode 100644 index 0000000000..27080024c5 --- /dev/null +++ b/racket/src/schemify/fasl.rkt @@ -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)) diff --git a/racket/src/schemify/main.rkt b/racket/src/schemify/main.rkt index f0856a9cc9..f113f69084 100644 --- a/racket/src/schemify/main.rkt +++ b/racket/src/schemify/main.rkt @@ -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->)