From 2c9bf9445174166b17956e1109db2af07c1fb4ad Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 31 Jan 2020 13:28:13 -0700 Subject: [PATCH] cs: faster struct hashing and `struct->vector` Take advantage of `$record-type-field-count` to replace `record-type-field-names`, which isn't constant-time. --- pkgs/base/info.rkt | 2 +- racket/src/cs/compile-file.ss | 2 +- racket/src/cs/rumble/struct.ss | 113 ++++++++++++++++++-------------- racket/src/racket/src/schvers.h | 2 +- 4 files changed, 65 insertions(+), 54 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 3d7577b098..d00ecd17df 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.6.0.8") +(define version "7.6.0.9") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 74bd732ea9..24fa860b01 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -2,7 +2,7 @@ ;; Check to make we're using a build of Chez Scheme ;; that has all the features we need. (define-values (need-maj need-min need-sub need-dev) - (values 9 5 3 16)) + (values 9 5 3 17)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss index 90ea0f234e..b4c9fc58fd 100644 --- a/racket/src/cs/rumble/struct.ss +++ b/racket/src/cs/rumble/struct.ss @@ -584,6 +584,14 @@ ;; Register guard (register-guards! rtd parent-rtd guard 'at-start))))])) +;; Field count (init + auto) not including paren fields +(define (record-type-field-count rtd) + (fx- (#%$record-type-field-count rtd) + (let ([parent-rtd (record-type-parent rtd)]) + (if parent-rtd + (#%$record-type-field-count parent-rtd) + 0)))) + ;; Used by a `schemify` transformation: (define (structure-type-lookup-prefab-uid name parent-rtd* init-count auto-count auto-val immutables) ;; Return a UID for a prefab structure type. We can assume that @@ -665,7 +673,7 @@ (hashtable-set! rtd-mutables rtd mutables))) (define (check-accessor-or-mutator-index who rtd pos) - (let* ([total-count (#%vector-length (record-type-field-names rtd))]) + (let* ([total-count (record-type-field-count rtd)]) (unless (< pos total-count) (if (zero? total-count) (raise-arguments-error who @@ -928,7 +936,7 @@ ;; corresponds to `(make-field-info N 0 #f)`. (define (struct-type-field-info rtd*) (or (getprop (record-type-uid rtd*) 'field-info #f) - (let ([n (#%vector-length (record-type-field-names rtd*))] + (let ([n (record-type-field-count rtd*)] [parent-rtd* (record-type-parent rtd*)]) ;; If `parent-rtd` is not #f, then we'll get here ;; only if were still in the process of setting up @@ -973,7 +981,7 @@ (field-info-auto-adder fi))) (define (struct-type-total*-field-count rtd*) - (get-field-info-total*-count (struct-type-field-info rtd*))) + (#%$record-type-field-count rtd*)) (define (struct-type-parent-total*-count rtd*) (let ([p-rtd* (record-type-parent rtd*)]) @@ -1136,54 +1144,57 @@ (define struct->vector (case-lambda [(s dots) - (if (record? (strip-impersonator s)) - (let ([rtd (record-rtd (strip-impersonator s))]) - ;; Create that vector that has '... for opaque ranges and each field - ;; value otherwise - (let-values ([(vec-len rec-len) - ;; First, get the vector and record sizes - (let loop ([vec-len 1] [rec-len 0] [rtd rtd] [dots-already? #f]) - (cond - [(not rtd) (values vec-len rec-len)] - [else - (let ([len (#%vector-length (record-type-field-names rtd))]) - (cond - [(struct-type-immediate-transparent? rtd) - ;; A transparent region - (loop (+ vec-len len) (+ rec-len len) (record-type-parent rtd) #f)] - [dots-already? - ;; An opaque region that follows an opaque region - (loop vec-len (+ rec-len len) (record-type-parent rtd) #t)] - [else - ;; The start of opaque regions - (loop (add1 vec-len) (+ rec-len len) (record-type-parent rtd) #t)]))]))]) - ;; Walk though the record's types again, this time filling in the vector - (let ([vec (#%make-vector vec-len dots)]) - (vector-set! vec 0 (string->symbol (format "struct:~a" (record-type-name rtd)))) - (let loop ([vec-pos vec-len] [rec-pos rec-len] [rtd rtd] [dots-already? #f]) - (when rtd - (let* ([len (#%vector-length (record-type-field-names rtd))] - [rec-pos (- rec-pos len)]) - (cond - [(struct-type-immediate-transparent? rtd) - ;; Copy over a transparent region - (let ([vec-pos (- vec-pos len)]) - (let floop ([n 0]) - (cond - [(= n len) (loop vec-pos rec-pos (record-type-parent rtd) #f)] - [else - (vector-set! vec (+ vec-pos n) (unsafe-struct-ref s (+ rec-pos n))) - (floop (add1 n))])))] - [dots-already? - ;; Skip another opaque region - (loop vec-pos rec-pos (record-type-parent rtd) #t)] - [else - ;; The vector already has `dots` - (loop (sub1 vec-pos) rec-pos (record-type-parent rtd) #t)])))) - vec))) - ;; Any value that is not implemented as a record is treated as - ;; a fully opaque struct - (vector (string->symbol (format "struct:~a" ((inspect/object s) 'type))) dots))] + (let ([s* (strip-impersonator s)]) + (if (record? s*) + (let ([rtd (record-rtd s*)]) + ;; Create that vector that has '... for opaque ranges and each field + ;; value otherwise + (let-values ([(vec-len rec-len) + ;; First, get the vector and record sizes + (let loop ([vec-len 1] [rec-len 0] [rtd rtd] [dots-already? #f]) + (cond + [(not rtd) (values vec-len rec-len)] + [else + (let ([len (record-type-field-count rtd)]) + (cond + [(struct-type-immediate-transparent? rtd) + ;; A transparent region + (loop (fx+ vec-len len) (fx+ rec-len len) (record-type-parent rtd) #f)] + [dots-already? + ;; An opaque region that follows an opaque region + (loop vec-len (fx+ rec-len len) (record-type-parent rtd) #t)] + [else + ;; The start of opaque regions + (loop (fx+ 1 vec-len) (fx+ rec-len len) (record-type-parent rtd) #t)]))]))]) + ;; Walk though the record's types again, this time filling in the vector + (let ([vec (#%make-vector vec-len dots)]) + (#%vector-set! vec 0 (string->symbol (string-append-immutable + "struct:" + (#%symbol->string (record-type-name rtd))))) + (let loop ([vec-pos vec-len] [rec-pos rec-len] [rtd rtd] [dots-already? #f]) + (when rtd + (let* ([len (record-type-field-count rtd)] + [rec-pos (fx- rec-pos len)]) + (cond + [(struct-type-immediate-transparent? rtd) + ;; Copy over a transparent region + (let ([vec-pos (fx- vec-pos len)]) + (let floop ([n 0]) + (cond + [(fx= n len) (loop vec-pos rec-pos (record-type-parent rtd) #f)] + [else + (#%vector-set! vec (fx+ vec-pos n) (unsafe-struct-ref s (fx+ rec-pos n))) + (floop (fx+ 1 n))])))] + [dots-already? + ;; Skip another opaque region + (loop vec-pos rec-pos (record-type-parent rtd) #t)] + [else + ;; The vector already has `dots` + (loop (sub1 vec-pos) rec-pos (record-type-parent rtd) #t)])))) + vec))) + ;; Any value that is not implemented as a record is treated as + ;; a fully opaque struct + (vector (string->symbol (format "struct:~a" ((inspect/object s*) 'type))) dots)))] [(s) (struct->vector s '...)])) ;; ---------------------------------------- diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index a036e1e215..9b69f97d71 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 6 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 8 +#define MZSCHEME_VERSION_W 9 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x