suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

struct: don't generate excessive struct-field-index code

Browse Source 
The expansion of `struct` created far too much code to parameterize
`struct-field-index`, making expansion of a `struct` form with just
100 or 200 fields take a noticeably long time to expand.
This commit is contained in:
Matthew Flatt 2020-03-07 09:27:59 -07:00
parent 00b6803e36
commit 0de88f203d
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
racket/collects/racket/private/define-struct.rkt
View File

@ -101,6 +101,19 @@
(lambda (stx) (lambda (stx)
(raise-syntax-error #f "allowed only within a structure type definition" stx))) (raise-syntax-error #f "allowed only within a structure type definition" stx)))
(define-for-syntax (make-struct-field-index fields)
(lambda (stx)
(syntax-case stx ()
[(_ id)
(identifier? #'id)
(let loop ([pos 0] [fields (syntax->list fields)])
(cond
[(null? fields)
(raise-syntax-error #f "no such field" stx #'name)]
[(free-identifier=? #'id (car fields))
(datum->syntax #'here pos stx)]
[else (loop (add1 pos) (cdr fields))]))])))
(define (check-struct-type name what) (define (check-struct-type name what)
(when what (when what
(unless (struct-type? what) (unless (struct-type? what)
@ -617,14 +630,7 @@
(define-values (#,struct: #,make- #,? #,@sels #,@sets) (define-values (#,struct: #,make- #,? #,@sels #,@sets)
(let-values ([(struct: make- ? -ref -set!) (let-values ([(struct: make- ? -ref -set!)
(syntax-parameterize ([struct-field-index (syntax-parameterize ([struct-field-index
(lambda (stx) (make-struct-field-index (quote-syntax #,(map field-id fields)))])
(syntax-case stx #,(map field-id fields)
#,@(let loop ([fields fields][pos 0])
(cond
[(null? fields) null]
[else (cons #`[(_ #,(field-id (car fields))) #'#,pos]
(loop (cdr fields) (add1 pos)))]))
[(_ name) (raise-syntax-error #f "no such field" stx #'name)]))])
(make-struct-type #,reflect-name-expr (make-struct-type #,reflect-name-expr
#,super-struct: #,super-struct:
#,(- (length fields) auto-count) #,(- (length fields) auto-count)